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

Compare commits

base: noe:ddabfbeaa896c7c30274ce769dbefacc3f021447
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes
..
compare: noe:131b39bff0e158481fd9c6c17f099438337509d0
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes

No commits in common. "ddabfbeaa896c7c30274ce769dbefacc3f021447" and "131b39bff0e158481fd9c6c17f099438337509d0" have entirely different histories.
ddabfbeaa8 ... 131b39bff0

78 changed files with 1093 additions and 6550 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -28,8 +28,6 @@ static/arthur/js/
# the Django half's own state: the document database, the content-addressed blob
# store (tiers 2 and 3), and collectstatic's output
db.sqlite3
db.sqlite3-shm
db.sqlite3-wal
/var/
# vim swap files

25
README.md
View file

@ -17,7 +17,7 @@ modern conveniences belong in the workflow, not the output. See
## ClojureScript port
The active port plays the synthetic take, accepts video uploads, transcodes them
to an H.264 proxy and decodable stream plus audio and tracing stills, analyzes real footage
to a browser-seekable proxy plus audio and tracing stills, analyzes real footage
for mouth, eyes, brows and pixel-derived teeth, and saves the project with
reusable analysis data. The step 8 data model
represents persistent feature IDs, eye pairs and feature-level observation gaps;
@ -64,7 +64,7 @@ Three tiers, cut by mutability and size — the full argument is in
| --- | --- | --- |
| 1 **authored** | the scene: nodes, channels, features, time maps | the database, as independently addressed leaves. Kilobytes |
| 2 **derived** | detected landmarks, raw mouth crops, and dense channel blocks | `var/blobs`, addressed by analysis and block inputs, including the detector version |
| 3 **source** | the uploaded video, H.264 proxy and elementary stream, tracing stills, and audio | the same blob store, by the hash of their bytes |
| 3 **source** | the uploaded video, the H.264 proxy measured from it, its tracing stills, and audio | the same blob store, by the hash of their bytes |
Only tier 1 is the document. Tier 2 is a pure function of tiers 1 and 3, so a
saved project names its blocks rather than carrying them, and a knob change gives
@ -90,25 +90,28 @@ wasm, which is fetched from a CDN on first use.
For real footage:
Upload it in the app. `./extract.sh` still writes the old PNG-sequence bundle and
`ingest_bundle` still registers it, but footage ingested that way has no decodable
stream and the loader will say so — the measured pixels come out of the video now.
`ingest_bundle` still registers it, but footage ingested that way has no proxy and
the loader will say so — the measured pixels come out of the video now.
MediaPipe's wasm and `face_landmarker.task` are both local; nothing in detection
touches the network.
Detection reads the H.264 elementary stream with WebCodecs, one coded frame at a
time. The proxy has no B-frames, so decode order is frame order. Each decoded
frame reaches MediaPipe in VIDEO running mode at its footage timestamp. The
decoder and detector advance together, with a pause between frames so progress
can paint. Saved analyses reuse their stored crop pixels and measure them with
the same pauses.
Detection reads the VIDEO, not a frame per file. The page seeks the proxy to the
MIDDLE of each frame — `(i + 0.5) / fps` — and waits for
`requestVideoFrameCallback` to hand the frame over, then checks the `mediaTime` it
reports against the frame it asked for. Both halves are load-bearing and both were
measured against the same footage decoded to PNGs: aiming at `i / fps` sits on a
frame boundary and landed one frame early 31 times in 91, and aiming at the middle
was exact on all 91. A run that gets a frame it did not ask for stops and says so,
because a one-frame slip between the landmarks and the audio is not something
anyone finds by looking at the result.
This is what replaced the PNG sequence, which was 112MB for 7.6 seconds and would
be 1.1GB at the 900-frame limit. The proxy is 6MB, and the landmarks barely
notice: detected off decoded H.264 rather than off the PNGs, they moved at most
0.0033 of frame width.
The server's footage manifest records the proxy's frame rate and frame count;
`manifest.json` records the source rate. The extractor keeps every source frame;
the page reads that rate because a guessed fps desynchronises audio from picture.
Choosing a lower picture rate happens after analysis.

16
clips/blobs.py
View file

@ -16,13 +16,11 @@ addressing that answers questions about work not yet done.
import hashlib
import os
import tempfile
import zlib
from pathlib import Path
from django.conf import settings
CHUNK = 1 << 20
CROP_MEDIA_TYPE = "application/zlib"
def digest_bytes(data: bytes) -> str:
@ -88,20 +86,6 @@ def write_stream(chunks) -> tuple[str, int]:
return digest.hexdigest(), size
def write_compressed_stream(chunks) -> tuple[str, int]:
"""Store a losslessly compressed stream; the digest names stored bytes."""
compressor = zlib.compressobj()
def compressed():
for chunk in chunks:
if part := compressor.compress(chunk):
yield part
if part := compressor.flush():
yield part
return write_stream(compressed())
def adopt(source: Path) -> tuple[str, int]:
"""Store a file already on disk, by hard link where the filesystem allows it.

49
clips/extraction.py
View file

@ -106,10 +106,7 @@ def _encode_proxy(job, source_path, proxy_path, facts, root):
# step that makes the thing the page measures not be.
"-fps_mode", "cfr", "-r", facts.get("rate") or str(facts["fps"]),
"-c:v", "libx264", "-preset", "veryfast", "-crf", PROXY_CRF,
# NO B-FRAMES, AND THIS IS THE LOAD-BEARING FLAG. It is what makes
# decode order presentation order, so the page can treat access unit k
# of the elementary stream as frame k without demuxing a container or
# consulting a timestamp. With them x264 has a
# NO B-FRAMES, AND THIS IS THE LOAD-BEARING FLAG. With them x264 has a
# two-frame reordering delay, ffmpeg compensates by writing an edit list
# (`elst` media_time 1024 at timebase 1/15360 — exactly two frames), and
# the browser then lives on two timelines at once: `currentTime` obeys the
@ -128,25 +125,6 @@ def _encode_proxy(job, source_path, proxy_path, facts, root):
root, "proxy", total, (0, 55))
def _elementary_stream(proxy_path, out_path):
"""The proxy's video, unwrapped into a raw Annex-B H.264 stream.
A STREAM COPY, not a second encode: the same coded frames as the MP4, with
the container's length-prefixed NAL units rewritten as start-code-delimited
ones. It costs a file read and nothing else.
This exists because the page decodes with WebCodecs, and `VideoDecoder` takes
demuxed chunks rather than a container. Handing it Annex-B means the client
needs no demuxer: NAL start codes are findable in a loop, and because the
proxy is encoded with no B-frames, decode order is presentation order — so
access unit k IS frame k, with no container timing to consult and no clock to
reconcile. That is the whole reason this file is worth the bytes it costs.
"""
_command(["ffmpeg", "-hide_banner", "-loglevel", "error", "-y",
"-i", str(proxy_path), "-an", "-c:v", "copy",
"-bsf:v", "h264_mp4toannexb", "-f", "h264", str(out_path)])
def _extract_stills(job, proxy_path, frames_dir, frames, root):
"""The proxy -> one tracing JPEG per frame, long edge capped."""
_run_with_progress(
@ -256,16 +234,13 @@ def count_frames(path):
def extraction_key(source, settings):
# Scheme 3: the extraction now also produces the elementary stream the page
# decodes, so a job run under scheme 2 did not make everything this one does.
text = json.dumps({"scheme": 3, "source": source.blob_id, "settings": settings},
text = json.dumps({"scheme": 2, "source": source.blob_id, "settings": settings},
sort_keys=True, separators=(",", ":"))
return "sha256:" + hashlib.sha256(text.encode()).hexdigest()
def _register(job, proxy_path, stream_path, stills, audio_path, facts):
def _register(job, proxy_path, stills, audio_path, facts):
proxy_digest, proxy_size = blobs.adopt(proxy_path)
stream_digest, stream_size = blobs.adopt(stream_path)
audio_digest, audio_size = blobs.adopt(audio_path)
still_blobs = [(index, *blobs.adopt(path)) for index, path in enumerate(stills)]
width, height, fps, frames = facts["width"], facts["height"], facts["fps"], facts["frames"]
@ -281,24 +256,13 @@ def _register(job, proxy_path, stream_path, stills, audio_path, facts):
with transaction.atomic():
proxy_blob, _ = Blob.objects.get_or_create(
digest=proxy_digest, defaults={"size": proxy_size, "media_type": "video/mp4"})
stream_blob, _ = Blob.objects.get_or_create(
digest=stream_digest, defaults={"size": stream_size, "media_type": "video/h264"})
audio_blob, _ = Blob.objects.get_or_create(
digest=audio_digest, defaults={"size": audio_size, "media_type": "audio/wav"})
footage, created = Footage.objects.get_or_create(
digest=h.hexdigest(),
defaults={"label": job.source.filename[:200], "source": job.source.filename[:200],
"fps": fps, "frames": frames, "width": width, "height": height,
"audio": audio_blob, "video": proxy_blob, "stream": stream_blob})
if not created and not footage.stream_id:
# The same footage by identity, extracted before the elementary
# stream existed. Its digest is over the proxy and the audio, which
# have not changed — so this is the same footage gaining a file it
# was always entitled to, not a different one.
footage.stream = stream_blob
if not footage.video_id:
footage.video = proxy_blob
footage.save(update_fields=["stream", "video"])
"audio": audio_blob, "video": proxy_blob})
if created:
rows = []
for index, digest, size in still_blobs:
@ -342,9 +306,6 @@ def run(key):
"audio would drift")
proxy_facts["frames"] = frames
stream_path = root / "proxy.h264"
_elementary_stream(proxy_path, stream_path)
frames_dir = root / "stills"
frames_dir.mkdir()
_extract_stills(job, proxy_path, frames_dir, frames, root)
@ -364,7 +325,7 @@ def run(key):
"-f", "lavfi", "-i", "anullsrc=r=44100:cl=mono",
"-t", str(frames / proxy_facts["fps"]), "-c:a", "pcm_s16le",
str(audio_path)])
footage = _register(job, proxy_path, stream_path, stills, audio_path, proxy_facts)
footage = _register(job, proxy_path, stills, audio_path, proxy_facts)
job.footage, job.state, job.progress = footage, "done", 100
job.save(update_fields=["footage", "state", "progress", "updated"])
except Exception as exc:

57
clips/management/commands/compress_crop_blocks.py
View file

@ -1,57 +0,0 @@
"""Compress existing raw mouth crop blocks without changing their public bytes."""
import hashlib
import zlib
from django.core.management.base import BaseCommand, CommandError
from django.db import transaction
from django.db.models.deletion import ProtectedError
from clips import blobs
from clips.models import Blob, Block
class Command(BaseCommand):
help = "Compress existing source/crops blobs and remove unreferenced raw copies"
def handle(self, *args, **options):
converted = 0
before = after = 0
for block in Block.objects.filter(role="source/crops").select_related("data"):
old = block.data
if old.media_type == blobs.CROP_MEDIA_TYPE:
continue
old_digest = old.digest
with open(blobs.path_for(old_digest), "rb") as source:
digest, size = blobs.write_compressed_stream(
iter(lambda: source.read(blobs.CHUNK), b"")
)
check = hashlib.sha256()
decompressor = zlib.decompressobj()
with open(blobs.path_for(digest), "rb") as compressed:
while chunk := compressed.read(blobs.CHUNK):
check.update(decompressor.decompress(chunk))
check.update(decompressor.flush())
if not decompressor.eof or check.hexdigest() != old_digest:
raise CommandError(f"crop compression failed verification: {block.key}")
with transaction.atomic():
new, _ = Blob.objects.get_or_create(
digest=digest,
defaults={"size": size, "media_type": blobs.CROP_MEDIA_TYPE},
)
changed = Block.objects.filter(key=block.key, data=old).update(data=new)
if not changed:
continue
converted += 1
before += old.size
after += size
if old_digest != new.digest:
try:
old.delete()
except ProtectedError:
pass
else:
blobs.path_for(old_digest).unlink(missing_ok=True)
self.stdout.write(
f"Compressed {converted} crop blocks: {before:,} -> {after:,} bytes"
)

24
clips/migrations/0005_footage_stream_alter_footage_video.py
View file

@ -1,24 +0,0 @@
# Generated by Django 5.2.17 on 2026-09-28 17:11
import django.db.models.deletion
from django.db import migrations, models
class Migration(migrations.Migration):
dependencies = [
('clips', '0004_footage_video_alter_footageframe_index'),
]
operations = [
migrations.AddField(
model_name='footage',
name='stream',
field=models.ForeignKey(blank=True, help_text="the proxy's video as raw Annex-B H.264: what the page DECODES, one access unit per frame; null on footage extracted before it", null=True, on_delete=django.db.models.deletion.PROTECT, related_name='stream_for', to='clips.blob'),
),
migrations.AlterField(
model_name='footage',
name='video',
field=models.ForeignKey(blank=True, help_text='the browser-safe proxy, playable and seekable', null=True, on_delete=django.db.models.deletion.PROTECT, related_name='video_for', to='clips.blob'),
),
]

15
clips/migrations/0006_project_schema_version.py
View file

@ -1,15 +0,0 @@
from django.db import migrations, models
class Migration(migrations.Migration):
dependencies = [
("clips", "0005_footage_stream_alter_footage_video"),
]
operations = [
migrations.AddField(
model_name="project",
name="schema_version",
field=models.PositiveIntegerField(default=1),
),
]

15
clips/models.py
View file

@ -102,12 +102,7 @@ class Footage(models.Model):
audio = models.ForeignKey(Blob, on_delete=models.PROTECT, related_name="audio_for")
video = models.ForeignKey(
Blob, null=True, blank=True, on_delete=models.PROTECT, related_name="video_for",
help_text="the browser-safe proxy, playable and seekable",
)
stream = models.ForeignKey(
Blob, null=True, blank=True, on_delete=models.PROTECT, related_name="stream_for",
help_text="the proxy's video as raw Annex-B H.264: what the page DECODES, "
"one access unit per frame; null on footage extracted before it",
help_text="the browser-safe proxy the page detects from; null on pre-proxy footage",
)
feature_absence = models.JSONField(default=dict, blank=True)
created = models.DateTimeField(auto_now_add=True)
@ -199,14 +194,14 @@ class Block(models.Model):
class Project(models.Model):
"""Tier 1: the document's root.
`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` is the monotonic project version docs/architecture.md asks for. Every
write bumps it, and a client that sees `seq > local + 1` refetches — which is
what makes staleness self-healing rather than permanent once there is a
broadcast to miss.
"""
id = models.UUIDField(primary_key=True, default=uuid.uuid4, editable=False)
name = models.CharField(max_length=200, default="untitled")
schema_version = models.PositiveIntegerField(default=1)
seq = models.PositiveBigIntegerField(default=0)
palette = models.CharField(max_length=64, default="arthur/default")
created = models.DateTimeField(auto_now_add=True)

28
clips/templates/clips/index.html
View file

@ -27,13 +27,6 @@ and PUTs with ordinary CSRF protection — no endpoint in this app is exempt.
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; }
@ -55,27 +48,6 @@ and PUTs with ordinary CSRF protection — no endpoint in this app is exempt.
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>
</head>

73
clips/tests/test_api.py
View file

@ -16,7 +16,6 @@ of the system rather than a convention in ClojureScript:
The rest is the load/save round trip, the conditional write, and the footage
manifest that makes the frames the backend's to serve.
"""
import base64
import hashlib
import json
import shutil
@ -24,13 +23,11 @@ import struct
import subprocess
import tempfile
import zlib
from io import StringIO
from pathlib import Path
from unittest import skipUnless
from unittest.mock import Mock, patch
from django.core.files.uploadedfile import SimpleUploadedFile
from django.core.management import call_command
from django.test import TestCase, override_settings
from clips import blobs, extraction
@ -218,47 +215,6 @@ class Tier2Tests(TestCase):
self.assertEqual("AAE=", fetched["state"])
self.assertEqual(descriptor, fetched["descriptor"])
@override_settings(DATA_UPLOAD_MAX_MEMORY_SIZE=1024, FILE_UPLOAD_MAX_MEMORY_SIZE=1024)
def test_large_block_upload_streams_past_json_body_limit(self):
analysis = self.register_analysis()
descriptor = block_descriptor(analysis, role="source/crops")
key = key_for(descriptor)
payload = bytes(range(256)) * 16
response = self.client.post("/api/blocks", {
"key": key,
"descriptor": descriptor,
"data": SimpleUploadedFile("block.bin", payload),
"state": SimpleUploadedFile("state.bin", b"\x00\x01"),
})
self.assertEqual(201, response.status_code, response.content)
row = Block.objects.get(key=key)
self.assertEqual(blobs.CROP_MEDIA_TYPE, row.data.media_type)
self.assertLess(row.data.size, len(payload))
self.assertEqual(payload, zlib.decompress(blobs.read(row.data_id)))
self.assertEqual(base64.b64encode(payload).decode(),
self.client.get(f"/api/blocks/{key}").json()["data"])
self.assertEqual(b"\x00\x01", blobs.read(row.state_id))
def test_existing_raw_crop_block_is_compressed_without_changing_its_key_or_read(self):
analysis = self.register_analysis()
descriptor = block_descriptor(analysis, role="source/crops")
key = key_for(descriptor)
payload = b"raw crop pixels" * 100
digest, size = blobs.write(payload)
old = Blob.objects.create(digest=digest, size=size)
Block.objects.create(key=key, descriptor=descriptor, role="source/crops",
analysis_id=analysis, data=old)
call_command("compress_crop_blocks", stdout=StringIO())
row = Block.objects.select_related("data").get(key=key)
self.assertEqual(blobs.CROP_MEDIA_TYPE, row.data.media_type)
self.assertEqual(base64.b64encode(payload).decode(),
self.client.get(f"/api/blocks/{key}").json()["data"])
self.assertFalse(blobs.path_for(digest).exists())
compressed_digest = row.data_id
call_command("compress_crop_blocks", stdout=StringIO())
self.assertEqual(compressed_digest, Block.objects.get(key=key).data_id)
def test_a_block_whose_analysis_is_unknown_is_refused(self):
descriptor = block_descriptor("sha256:" + "f" * 64)
response = self.post("/api/blocks", {
@ -327,34 +283,6 @@ class Tier2Tests(TestCase):
f"/api/analyses/{analysis}", json.dumps({"source_blocks": keys[:2]}),
content_type="application/json").status_code)
def test_source_roles_are_complete_and_unique_per_subject(self):
analysis = self.register_analysis()
keys = []
for subject in ("face-1", "face-2"):
for role in ("source/dense", "source/detected", "source/crops"):
desc = json.loads(block_descriptor(analysis, role=role))
desc["features"] = [subject]
descriptor = json.dumps(desc, sort_keys=True, separators=(",", ":"))
key = key_for(descriptor)
self.assertEqual(201, self.post("/api/blocks", {
"key": key, "descriptor": descriptor, "data": "AA==",
}).status_code)
keys.append(key)
def put(keys):
return self.client.put(f"/api/analyses/{analysis}",
json.dumps({"source_blocks": keys}),
content_type="application/json")
self.assertEqual(400, put(keys[:-1]).status_code)
self.assertEqual(400, put(keys + keys[:1]).status_code)
self.assertEqual(200, put(keys).status_code)
self.assertEqual(200, put(list(reversed(keys))).status_code)
self.assertEqual(409, put(keys[:3]).status_code)
self.assertEqual(set(keys), set(self.client.get(
f"/api/analyses/{analysis}").json()["source_blocks"]))
@override_settings(BLOB_ROOT=BLOB_DIR)
class DocumentTests(TestCase):
@ -407,7 +335,6 @@ class DocumentTests(TestCase):
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(1, len(loaded["clips"]))
clip = loaded["clips"][0]
self.assertEqual("c1", clip["cid"])

73
clips/views.py
View file

@ -26,7 +26,6 @@ tool got worse", with no event to attach it to.
import hashlib
import json
import re
import zlib
from functools import lru_cache
from pathlib import Path
from uuid import UUID
@ -99,22 +98,6 @@ def _blob(b64, media_type="application/octet-stream"):
return blob
def _uploaded_blob(upload, media_type="application/octet-stream"):
digest, size = blobs.write_stream(upload.chunks())
blob, _ = Blob.objects.get_or_create(
digest=digest, defaults={"size": size, "media_type": media_type}
)
return blob
def _crop_blob(chunks):
digest, size = blobs.write_compressed_stream(chunks)
blob, _ = Blob.objects.get_or_create(
digest=digest, defaults={"size": size, "media_type": blobs.CROP_MEDIA_TYPE}
)
return blob
# ---------------------------------------------------------------------------
# the page
@ -257,8 +240,6 @@ def _footage_json(footage: Footage, urls=True):
# existed, which the loader reports as "re-extract this" rather than
# failing somewhere inside MediaPipe.
"video": f"/blob/{footage.video.digest}" if footage.video_id else None,
# What the page actually decodes: one access unit per frame, no container.
"stream": f"/blob/{footage.stream.digest}" if footage.stream_id else None,
"feature-absence": footage.feature_absence or {},
}
if urls:
@ -276,7 +257,7 @@ def footage_list(request):
@require_http_methods(["GET"])
def footage_detail(request, footage_id):
try:
footage = Footage.objects.select_related("audio", "video", "stream").get(id=footage_id)
footage = Footage.objects.select_related("audio", "video").get(id=footage_id)
except Footage.DoesNotExist:
return JsonResponse({"error": "no such footage"}, status=404)
return JsonResponse(_footage_json(footage))
@ -433,23 +414,12 @@ def analysis_detail(request, key):
try:
keys = _body(request).get("source_blocks")
roles = {"source/dense", "source/detected", "source/crops"}
if (not isinstance(keys, list) or not keys
or not all(isinstance(k, str) for k in keys) or len(set(keys)) != len(keys)):
raise Bad("an analysis needs distinct source block keys")
if not isinstance(keys, list) or len(keys) != len(roles) or len(set(keys)) != len(roles):
raise Bad("an analysis needs one block for each source role")
blocks = list(Block.objects.filter(key__in=keys))
if len(blocks) != len(keys) or any(b.analysis_id != key for b in blocks):
raise Bad("source blocks must exist and name this analysis")
by_subject = {}
for block in blocks:
subjects = json.loads(block.descriptor).get("features", [])
if (not isinstance(subjects, list) or len(subjects) > 1
or any(not isinstance(s, str) or not s for s in subjects)):
raise Bad("a source block must name one subject")
# Older single-face analyses used an empty feature list.
by_subject.setdefault(tuple(subjects), []).append(block.role)
if any(len(found) != len(roles) or set(found) != roles
for found in by_subject.values()):
raise Bad("each subject needs one block for each source role")
if (len(blocks) != len(roles) or {b.role for b in blocks} != roles
or any(b.analysis_id != key for b in blocks)):
raise Bad("source blocks must have distinct source roles and name this analysis")
with transaction.atomic():
row = Analysis.objects.select_for_update().get(key=key)
current = set(row.source_blocks.values_list("key", flat=True))
@ -484,10 +454,7 @@ def blocks(request):
"""Store one dense block: its bytes, its optional absence mask, and the
descriptor its key is the hash of."""
try:
multipart = request.content_type == "multipart/form-data"
data = request.POST if multipart else _body(request)
upload = request.FILES.get("data") if multipart else None
state_upload = request.FILES.get("state") if multipart else None
data = _body(request)
key = data.get("key")
descriptor = data.get("descriptor")
parsed = _check_key(key, descriptor)
@ -509,27 +476,17 @@ def blocks(request):
"version that produced it",
analysis=analysis_key,
)
if not (upload and upload.size) and not data.get("data"):
if not data.get("data"):
raise Bad("a block with no bytes")
with transaction.atomic():
if role == "source/crops":
if upload:
data_blob = _crop_blob(upload.chunks())
else:
import base64
data_blob = _crop_blob([base64.b64decode(data["data"])])
else:
data_blob = _uploaded_blob(upload) if upload else _blob(data["data"])
row, created = Block.objects.get_or_create(
key=key,
defaults={
"descriptor": descriptor,
"role": role,
"analysis": analysis,
"data": data_blob,
"state": (_uploaded_blob(state_upload) if state_upload else
_blob(data["state"]) if data.get("state") else None),
"data": _blob(data["data"]),
"state": _blob(data["state"]) if data.get("state") else None,
},
)
return JsonResponse({"key": row.key, "created": created}, status=201 if created else 200)
@ -545,13 +502,10 @@ def block_detail(request, key):
row = Block.objects.select_related("data", "state").get(key=key)
except Block.DoesNotExist:
return JsonResponse({"error": "no such block"}, status=404)
data = blobs.read(row.data.digest)
if row.data.media_type == blobs.CROP_MEDIA_TYPE:
data = zlib.decompress(data)
out = {
"key": row.key,
"descriptor": row.descriptor,
"data": base64.b64encode(data).decode("ascii"),
"data": base64.b64encode(blobs.read(row.data.digest)).decode("ascii"),
}
if row.state_id:
out["state"] = base64.b64encode(blobs.read(row.state.digest)).decode("ascii")
@ -582,7 +536,6 @@ def _project_json(project: Project):
return {
"id": str(project.id),
"name": project.name,
"schema_version": project.schema_version,
"seq": project.seq,
"palette": project.palette,
"clips": clips,
@ -595,8 +548,7 @@ def projects(request):
return JsonResponse(
{
"projects": [
{"id": str(p.id), "name": p.name,
"schema_version": p.schema_version, "seq": p.seq,
{"id": str(p.id), "name": p.name, "seq": p.seq,
"updated": p.updated.isoformat()}
for p in Project.objects.all()[:100]
]
@ -703,7 +655,6 @@ def _save(project: Project, data):
return JsonResponse(
{
"id": str(project.id),
"schema_version": project.schema_version,
"seq": seq,
"written": sorted(written),
"removed": sorted(removed),

93
docs/animation-model.md
View file

@ -180,10 +180,9 @@ Three channel shapes, and the uniformity across them is the point:
```
`:interp` defaults to `:hold`, which `docs/design.md` requires of every cut part.
An authored keyed channel may also carry `:segments {8 :linear}`: the key at 8
tweens toward the next key, while other gaps use the channel default. The
transition belongs to the gap starting at a key, so a shape can cut into one
drawing and tween out of it. Per-key easing beyond hold and linear is deferred.
A key may carry its own `:interp` to override the channel's, which is how Lottie
and Blender both do per-key easing; nothing uses it yet and the door is cheap to
leave open.
### Keys are a map by frame, not a list
@ -339,47 +338,54 @@ head is placed and scaled where it belongs and the rest of the frame is simply
not on stage. The full frame stays *available* for tracing without being
*visible*, and those are different requirements.
## Head motion: free or anchored to measured frames
## The anchor: stabilisation is a channel, not a mode
`stabilize` produces `{s, θ, tx, ty}` per source frame. Its inverse is stored
densely on `:head`'s position, rotation and scale channels. The same measured
track serves every placement choice:
`stabilize` produces `{s, θ, tx, ty}` per frame, which is exactly
`[:xform :scale]`, `[:xform :rot]` and `[:xform :pos]`. So removing the head's
motion is not a pipeline setting — it is a question of **which node holds that
motion**, and the answer is one channel definition:
```clojure
;; no :anchors — free: read the measured transform at the current frame
;; one key — lock to a chosen measured frame throughout
:anchors {0 12}
;; several keys — cut to another measured head transform at frame 40
:anchors {0 12, 40 42}
;; locked: the head sits still, for tracing and for judging articulation
[:xform :pos] {:animated? false :value [0.0 0.0]}
;; as filmed: the head moves around the stage
[:xform :pos] {:animated? true :interp :hold
:dense {:store "sha256:…" :stride 2 :frames 600}
:generated {:by :anchor/similarity}}
;; per plate: the head snaps at each selected frame and holds
[:xform :pos] {:animated? true :interp :hold :keys {0 […], 12 […], 23 […]}}
```
The map is `local change frame -> measured source frame`. A single lock is a
one-key map. Position, rotation and scale read the same held source frame. The
frame set belongs to head placement, independently of plate drawings and stage
pose cuts. No measured block is copied into authored transform keys.
The three modes are the three channel shapes, on one channel, on one node. The
third is the one a plate strip wants — the head pose is stable for exactly as
long as a drawing is on screen — and it costs nothing because `:keys` already
exists. Its frame set is the kept-frame set, which is `suggestPlateFrames` in the
prototype and belongs to painting rather than to measurement.
**Always measure, always store factored.** The fit is computed and the geometry
is stored head-local in every mode. Only the frame address used to read the
head's measured transform changes. Two things downstream require that split:
**Always measure, always store factored, toggle the parent.** The fit is computed
and the geometry is stored head-local in every mode, and only the parent's
channel changes. Two things downstream require it, and both would be lost by
making this an analysis-time switch:
- *Smoothing.* "Smooth the transform, never the contour" only means anything
while the two are separate.
- *Key selection.* A velocity minimum is "articulation paused" in head-local
space and "the head happened to be still" in image space.
This is a document edit, not a reason to re-analyse. A registered tracing photo
will use its own source frame's stabilising transform followed by the same
selected head placement, so it aligns with the vectors drawn over it.
It also makes the toggle an edit to the document rather than a reason to
re-analyse: tier 1, undoable, syncable, and instant.
### Two nodes, because two different things want that transform
```
:face group — AUTHORED. where the face sits on the stage, and how big.
:head group — MEASURED. dense head motion read at the selected frame.
:head group — MEASURED. the head's motion, or identity.
:mouth :mouth-in :teeth :lid-r :lid-l :brow-r :brow-l …
```
Changing anchor keys edits `:head` and never touches `:face`, so it cannot move
Switching modes rewrites `:head` and never touches `:face`, so it cannot move
something that was placed by hand. A group node is free, and keeping the authored
and the measured transform apart is the whole reason the transform is decomposed
in the first place.
@ -489,39 +495,6 @@ reading head over the same channel. The resolver keys its caches by the instance
path, not by node id — which is a detail of `Making it fast` below, and the one
place symbol nesting is not free.
### Audio placements and controls
Sound is placed on a timeline as a separate `:audio` node. It uses the same
`:span`, `:time`, and channel representation as a drawn node. A `:linked-to` id
records which picture instance it was placed with; it does not force the two
spans or source in-points to match.
```clojure
{:id :voice-right :kind :audio :parent :root :z "a4"
:linked-to :right
:source {:footage "f8cace9e-..."}
:span [48 260]
:time {:mode :map :at 48 :in 0 :rate 1}
:channels {[:audio :gain]
{:animated? true :interp :linear
:keys {48 0.0, 60 1.0, 245 1.0, 259 0.0} :over []}}}
```
`[:audio :gain]`, `[:audio :pan]`, and `[:audio :rate]` are ordinary scalar
channels. They may be framed, keyed, or dense; numeric keyed channels can ramp
linearly. The time map sets the placement's base source rate, and
`[:audio :rate]` multiplies it. Audio is mixed from the referenced immutable
footage when the clip opens. The mix is derived output; the saved document holds
the nodes and channel keys, not another audio file. One audio element plays that
mix and remains the clock for both sound and picture.
This is also the boundary for a future control surface. A control has a stable
target, such as a feature's `:verts` setting or an audio node's
`[:audio :gain]` channel. The UI and a MIDI binding can address both through the
same control interface. Their update costs differ: gain can be keyed over time;
changing the number of lip vertices changes topology and must regenerate its
dense geometry. A topology setting cannot be treated as a per-frame gain curve.
## Evaluating a frame
```clojure
@ -620,12 +593,12 @@ Proof that it covers what exists, not just what is wanted:
| brow ring + quantised raise | node `:brow-r`, `[:geom :pts]` dense (the traced ring with height removed), `[:xform :pos]` dense (the quantised raise). **The decomposition design.md insists on is two channels.** |
| head plate, kept frames | node `:head`, `:symbol` per instance, keys on `[:symbol]` at kept frames |
| `makeXform` face-oval crop | **gone.** Placement is `[:xform :*]` on `:face`; the stage clips |
| `stabilize` transforms | dense `[:xform :*]` on `:head`, read through its optional `:anchors` map |
| `stabilize` transforms | `[:xform :*]` on `:head` — framed identity, dense, or keyed at kept frames |
| registered underlay | not data — a UI layer riding `(world-of resolver :head)` |
| painted background cel | node per layer, `[:geom :pts]` **framed**, `[:style :color]` framed |
| `mouth lead` | `:time {:offset k}` on performance nodes only |
| `exposure` | `:time {:expose n}` on the clip root, inherited |
| picture fps | resolver samples marked generated channels at the picture rate; authored keys keep their own time |
| picture fps | `:time {:source-fps s :sample-fps p}` on the clip root, applied after analysis |
| hand correction | an `:over` layer, `:offset` or `:replace` |
The brow row is the one worth looking at twice. `docs/design.md` argues at length

36
docs/architecture.md
View file

@ -145,8 +145,8 @@ boundary.**
| # | Stage | In | Out | Cost |
| --- | --- | --- | --- | --- |
| 1 | **ingest** | video | footage: an H.264 proxy and raw stream, tracing stills, audio, manifest | minutes, in-app |
| 2 | **detect** | the raw stream, decoded one frame at a time | raw landmarks per frame | minutes, **cached** |
| 1 | **ingest** | video | footage: a seekable H.264 proxy, tracing stills, audio, manifest | minutes, in-app |
| 2 | **detect** | the proxy, walked one frame at a time | raw landmarks per frame | minutes, **cached** |
| 3 | **measure** | landmarks | anchor fit, residual, head-local rings, signals, interior pixels | seconds |
| 4 | **condition** | measurements | smoothed transforms and contours | milliseconds |
| 5 | **key** | conditioned signals + policy | channels: sparse keys, quantised holds, kept frames | milliseconds |
@ -444,12 +444,9 @@ must never run while the transport is moving.
The mouth crops are the non-obvious entry, and they are what makes remote work
possible at all. `extractTeeth` reads source pixels, so without them a
collaborator holding the analysis but not the source video cannot touch a
single teeth knob without decoding video again. These are RGBA crops: a 40×30
crop is 4.8KB raw, and current 200-pixel-wide crops can total over 12MB for a
take. The blob store compresses `source/crops` losslessly with zlib; block reads
return the original pixels. Run `python manage.py compress_crop_blocks` once to
convert existing raw crop blobs and remove their unreferenced copies.
collaborator holding the analysis but not the 600 source PNGs cannot touch a
single teeth knob. A 40×30 crop is about 1.2KB; a 600-frame take is under a
megabyte against hundreds for the footage.
### Bake B — resolved geometry. For scale.
@ -576,10 +573,10 @@ POST /api/analyses {key, descriptor} idempotent
GET /api/analyses/<key> metadata + source block keys
PUT /api/analyses/<key> link dense landmarks, mask, crops
POST /api/blocks/missing {keys} -> {missing}
POST /api/blocks multipart: key, descriptor, data file, optional state file (JSON also accepted)
POST /api/blocks {key, descriptor, data, state}
GET /api/blocks/<key>
GET /api/footage/<id> the manifest: video and stream URLs, audio, a URL per tracing still
GET /blob/<digest> immutable bytes, with byte ranges for video playback
GET /api/footage/<id> the manifest: the proxy to measure, audio, a URL per tracing still
GET /blob/<digest> immutable bytes, and RANGE-capable so a <video> can seek one
POST /api/sources multipart video upload
POST /api/extractions idempotent decode job
GET /api/extractions/<key> job state and footage id
@ -612,17 +609,20 @@ its own records. The producer changes; the shape does not.
**Tier 3 keeps a video, not a frame per file.** Stage 1 used to decode a PNG per
source frame: 112MB for 7.6 seconds at 1440x1920, and 1.1GB at the 900-frame
limit, for pixels whose only consumer was a canvas MediaPipe read once. It now
writes a browser-safe H.264 proxy — 6MB for the same take — and copies its coded
frames into an Annex-B stream. WebCodecs decodes that stream in order, and the
page gives each frame to MediaPipe in video running mode. The JPEG stills beside it
writes one browser-safe H.264 proxy — 6MB for the same take — and the page seeks
THAT, frame by frame, in MediaPipe's video running mode. The JPEG stills beside it
are reference images for tracing; nothing measures them, so they are deliberately
outside the footage digest and re-rendering them at another size does not
invalidate an analysis.
The proxy is encoded without B-frames, so decode order matches presentation
order. The client checks that the stream has exactly the manifest's frame count
before detection. `/blob/<digest>` also answers byte ranges for ordinary video
playback; Django's `FileResponse` does no Range handling, so this is code we own.
Two things make that trustworthy rather than merely smaller. `/blob/<digest>`
answers byte ranges, because a media element handed 200 with no `Accept-Ranges`
reports an empty `seekable` and silently refuses to move — Django's `FileResponse`
does no Range handling, so this is code we own. And every frame is CHECKED:
`requestVideoFrameCallback` states the `mediaTime` of the frame it hands over, the
walker compares it to the frame it asked for, and a mismatch ends the run. Content
addressing over landmarks whose frame alignment was assumed would be addressing a
guess.
**The document stores what a block IS, not what it holds.** A block's element type
is in its own descriptor, which is the only place it is written down: an

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

@ -1,101 +0,0 @@
# Multi-face representation
Status (2026-09-29): representation work complete. Reopen it for a concrete
requirement, rather than another round of abstract alternatives.
Implemented: each tracked face has a drawing timeline, placed by an ordinary
symbol instance. Timelines already provide local node names, independent playback,
and persistence. No new kind of scene container is needed.
```clojure
:timelines
{: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 {:nodes {:head {...} :mouth {:parent :head ...} ...}}
:face-2 {:nodes {:head {...} :mouth {:parent :head ...} ...}}}
:features
{:face-1/mouth {:subject :face-1 :timeline :face-1 :area :mouth
:nodes [:mouth :mouth-in]}
:face-2/mouth {:subject :face-2 :timeline :face-2 :area :mouth
:nodes [:mouth :mouth-in]}}
```
The example omits ordinary ids, frame counts and channel details.
## What belongs where
- A **subject** identifies a source track and supplies shared measurement settings.
Its timeline has the same id and contains its measured `:head`.
- A **feature** owns nodes in an explicitly named timeline. Its clip-level id is
qualified when generated; ownership is read from fields, never parsed from ids.
- A **node** has a local name. Parents, stencils and pose groups use local names too.
- An **instance** places and retimes a drawing. Its pose tracks can hold one face's
mouth while the other face continues moving.
Subject metadata and drawing timelines remain separate facts. Hand-drawn timelines
need no subject. Features retain explicit timeline references, so their locations
are not inferred from their labels.
Both filmed faces share one source-to-stage transform. Fitting them independently
would stack them at the center. Additional placement uses each instance's ordinary
channels. Cross-face draw order is the instances' `:z` order.
## Consequences
Regeneration updates the addressed timeline directly. There is no temporary swap
into `:main`, no special stage regeneration path, and no renaming of parents or
stencils. Composing a stage moves the take's root into the library and preserves
its child timelines. Settings appear once per tracked object, since all placements
read that same drawing.
Presence masks inside a subject use local feature names, matching measurement.
Freeze qualifies them when building block descriptors. Head and retained-source
blocks explicitly name their subject; otherwise two faces with identical detection
masks could produce different bytes under the same key. Analysis addresses also
include detection capacity and assignment settings, so old single-face detection
results cannot satisfy a new multi-face request.
Validation counts node ownership by `[timeline node]`. The server requires one
complete set of retained source roles **per subject**, rather than exactly three
blocks for the entire analysis.
Nested rectangles retain fractional sizes until rasterization. Rounding inside a
face timeline discarded small head-local pupils before the source-to-stage scale
was applied. This was a real rendering error missed by the earlier proposal's
coordinate-only benchmark; the regression now compares all mark extents as well.
## Verification and limits
`frontend/test/arthur/flow/multi_face_test.cljs` exercises two distinct subjects,
source block separation, detection and feature gaps, independent pose cuts and
regeneration, nested stage save/load, and equivalence to a flat single-face scene.
Existing geometry, raster, source, and regeneration tests cover the same paths.
`clips/tests/test_api.py` checks complete source roles per subject and immutability.
The browser suite checks rendering, pupils, playback, save/open, drawing and upload.
Assignment remains a nearest-centroid heuristic, with a version and distance gate
recorded in the analysis. Reordered detections, late arrivals and gaps are tested;
identity through crossings or long disappearances is not guaranteed. Assignment
happens before measurement, so correcting it requires measuring again.
This changes the freeze and retained-source contracts. It does not migrate older
flat captures; reanalyze their footage to use the new regeneration path. Existing
rendering and leaf codecs still understand their node/channel representation.
## Next steps
1. Commit the verified checkpoint: 319 frontend tests, 44 API tests, browser
checks, and app/test builds passed. Builds reported no warnings.
2. Exercise real two-person footage, especially crossings, late arrivals and
disappearances. Check assignment before treating the resulting geometry as
evidence about the representation.
3. Build performance-pose selection and instance-scoped picture rates, reusing
the existing held-frame lookup and pose groups.
4. Then build plate-drawing selection and independent tracing references.
The [timing handoff](timing-handoff.md) owns the detailed next implementation
sequence. Older flat captures need reanalysis unless a migration is separately
undertaken to preserve their authored edits.

37
docs/port-plan.md
View file

@ -2,7 +2,7 @@
Self-contained. You should not need any prior conversation to execute this.
**Implementation status (2026-09-29):** steps 0–9 are in. Step 6 reads extracted
**Implementation status (2026-09-28):** steps 0–9 are in. Step 6 reads extracted
footage, detects landmarks with local MediaPipe assets at full source cadence, and
runs the same freeze path as the synthetic take. The scene time map can sample the
frozen roto at a lower picture fps without changing source analysis, duration or
@ -13,24 +13,9 @@ absence intervals through measurement and freeze. Step 9 adds the Django backend
the three-tier split, content-addressed tier 2 with the detector version inside
every key, leaf addressing for tier 1, and project load/save that round-trips.
Step 8 now has parameter controls and scoped regeneration from retained source.
Multi-face representation is complete: each tracked subject has a drawing
timeline, placed by an ordinary symbol instance. See
[multi-face representation](multi-face-representation.md) for the implemented
model, verification and compatibility limits.
**Next, in order:** commit the verified checkpoint; exercise real two-person
footage, including crossings and disappearances; build performance-pose
Suggest/Keep/Drop and instance-scoped picture rates; then add plate-drawing
selection and independent tracing references. The
[timing handoff](timing-handoff.md) records current code and implementation order.
Reopen the representation only for a concrete requirement it cannot express.
**Still open:** real-footage identity validation, automatic per-feature detection,
the timing and tracing work above, and time-varying parameter settings. Older flat
captures need reanalysis for the new regeneration path; no migration is included.
The step descriptions below retain the original port scope; this status and the
linked handoffs describe subsequent work.
**Still open.** Step 8's parameter UI and scoped regeneration, and automatic
per-feature detection. Everything under "Out, and do not build it" below, which
step 9 did not touch.
## What arthur is
@ -370,7 +355,7 @@ stencilled by the sclera.
minus paint. The fixed pixel thresholds remain provisional; step 8 exposes their
parameters for tuning without changing the source track or picture timing.
### 8 — knobs — DONE for static settings and scoped regeneration
### 8 — knobs
Build the parameter model before its UI. Define each parameter once with its
default, validation, applicable area and regeneration dependencies. Store values
by stable subject and feature ID. Represent an eye pair as one group with one or
@ -391,9 +376,8 @@ visible eye. This is an input format, not a control UI or an automatic detector.
Use leaf-addressable settings under the clip, subject, feature and optional
group. Retain source measurements so a setting change can regenerate affected
channels without re-detecting footage. Static parameter controls and scoped
regeneration are implemented for takes and composed stages. Time-varying
parameter values remain deferred.
channels without re-detecting footage. Time-varying parameter values and all
parameter controls are deferred to the UI pass.
### 9 — backend — DONE
Django project, the `clips` app, models for
@ -447,7 +431,7 @@ nobody should pre-empt by porting the old one.
## Two things to not foreclose
Feature controls now handle more than one face; editing presence remains future work.
Feature controls will later handle more than one face and editing presence.
The underlying identity, occlusion and group association model begins in step 8:
- **Presence is not visibility.** An occluded feature has *no value* on a frame,
@ -456,6 +440,5 @@ The underlying identity, occlusion and group association model begins in step 8:
- **Params carry stable identity.** A subject and its features keep their IDs
across observation gaps. A run of visible frames is not a new identity.
The current identity tracker uses nearest-centroid assignment. Validate it on
real crossings and disappearances before choosing a more elaborate policy; the
iris and brow correspondence code offers whole-take voting as one option.
The identity tracker, when it comes, should use the same pattern the iris and brow
correspondences already use: vote across every frame rather than trusting one.

128
docs/timing-handoff.md
View file

@ -1,128 +0,0 @@
# Timing and frame-selection handoff
Status (2026-09-29): the multi-face representation is complete. Each face has a
local drawing timeline and an ordinary symbol instance. Keep that model; the next
feature is performance-pose selection, followed by plate drawings and tracing.
See [multi-face representation](multi-face-representation.md) for verification
and compatibility limits.
## Next steps, in order
1. **Commit the verified checkpoint.** Representation, scoped regeneration,
nested stage composition and source persistence are implemented and tested.
2. **Exercise real two-person footage.** Include crossings, late arrivals and
disappearances. Assignment is still a nearest-centroid heuristic; inspect
whether identities, landmarks and mouth crops stay together. Correcting an
assignment requires measuring again. Do not redesign the representation to
compensate for an assignment failure.
3. **Build performance-pose selection.** Propose frames from a target picture
rate, allow explicit Keep/Drop edits, and apply requests per instance. Reuse
the existing held-frame lookup and generated pose groups. Keep authored keys
and audio timing intact.
4. **Then build plate drawings and tracing.** Suggest drawing frames from head
displacement, allow manual choices, and give each cel an independently
selectable tracing reference.
Older flat captures need reanalysis for the new regeneration path. Migrating their
existing authored edits is separate work; it is not implemented by this checkpoint.
## Timing decisions
Keep the dense analyzed frames. Generated motion holds the most recent selected
source pose; removing a selected pose never deletes source data or shortens the
clip. Store edits in the animation's local frame space, so moving an instance
does not move its edits. Authored keys follow intentional instance retiming but
must not be quantized by a picture-rate request. Clip FPS and audio duration stay
fixed.
There are two selections with different owners, sharing held-frame lookup:
- **Performance poses:** propose a kept-frame list from the target picture rate,
then apply explicit keep/drop edits. A parent instance may request a lower
rate. Mouth outline, interior, teeth and visibility read the same selected
source frame; likewise each eye's coupled parts. Use group overrides when
needed, rather than a setting on every channel. Head motion currently has its
own anchor selection; do not silently put it under mouth timing.
- **Plate drawings:** start with frame 0, walk measured rigid head poses, and
suggest a frame when maximum landmark displacement from the last kept pose
exceeds tolerance. Let the artist add/remove frames. A removed drawing stays
stored so it can reappear if restored. This selection does not thin the mouth.
A target rate is approximate. Pin a useful closed-mouth pose at its actual frame,
even if that produces more changes than the target. Do not show a future pose
early to fit a grid. Manual drop wins over an automatic suggestion; make removal
of the only closed pose in a beat visible in the UI. Skip missing detections when
suggesting a replacement. Keep a frame-zero selection and hold the last selection
through the end. A skipped pose (hold), `[:vis] false` (hidden), and an absent
measurement remain different facts.
Store manual edits separately from generated proposals so changing the rate or
tolerance retains hand decisions. Selection edits change the document, not dense
blocks or analysis addresses. Verify save/open for every new field; extend leaf
handling and the relevant key whitelist if its storage location requires it.
## Current code: reuse these mechanisms
- `domain/pose.cljs` already has `prepare`, `held-frame` and `source-frame`.
Instance `:playback :tracks` map local change frames to held source frames,
keyed by pose group. Reuse this lookup; frame suggestion and Keep/Drop policy
are the missing layer. An explicit cut is not itself a complete selection UI.
- `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
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.
- The picture-rate option is currently passed through the resolver tree
unchanged. Instance-specific parent requests are still to be implemented.
Instance offset/rate must apply before selecting the local source pose.
- `pose/put-cut` and `remove-cut` currently address instances in `:main`.
A take's face instances are there, but a composed stage nests them inside a
shared source timeline. Make the editing scope explicit when adding nested
controls. A request on one outer placement must not rewrite the shared
drawing's playback settings for every placement.
- Generic root `:time :expose` still retimes descendants, and frozen takes still
store it. Paint nodes are rootless to escape it. When the selection path
replaces take picture cadence, remove that redundant quantization from the
take default; preserve intentional generic time maps. Moving exposure to
`:head` would still retime authored children.
- `freeze/head-mode` supports `:free` and `:anchored`. It keeps measured channels
dense and writes optional per-subject `:anchors` maps; it does **not** implement
`:per-plate` mode or materialize transform keys from `:kept`. Plate selection
should reuse held measured-frame addresses where appropriate, without
rerunning analysis or copying the measurements.
- `:over` hand corrections are currently refused by the channel reader. Their
future application belongs after generated pose selection.
## Performance-pose implementation sequence
1. Add pure proposal and Keep/Drop policy around the existing held-frame lookup.
Cover frame zero, nondivisible rates, manual precedence, missing poses and a
protected mouth closure. Preserve all source frames.
2. Feed instance requests and group selections into the existing channel read
path. Cover two faces, two differently timed placements of one source, nested
instances, coupled visibility/geometry, and authored keys at their normal time.
Use this same path for preview and export; keep audio duration unchanged.
3. Wire the performance strip's Suggest/Keep/Drop controls and persistence.
Replace the export pose estimate with the actual selection count. Retire the
take's redundant root exposure only when this path replaces its behavior.
## Plate drawings and tracing, afterward
The old suggestion algorithm is `js/pipeline.js:suggestPlateFrames`; the strip,
worksheet and tracing photo are in `js/app.js`. Port the useful policy over the
measured head poses and reuse held-frame lookup for the resulting drawing set.
Give a cel an editor-only source-frame reference, defaulting to its plate frame
but independently changeable. It may point to a frame omitted from either rendered
selection. Register the photo using that source frame's measured transform. The
old prototype coupled photo and cel addresses; independent tracing is new work.
The old iris socket lock, gaze origin, CLJS head anchors and registration pivot
are separate settings. Clarify what an "origin-lock" request means before adding
that control.
Keep the UI to two scopes: **performance poses** and **plate drawings**, each with
Suggest/Keep/Drop. Tracing reference and lock controls live with the cel or feature
they affect. No general keyframe framework is needed for this work.

86
docs/timing-model.md
View file

@ -1,86 +0,0 @@
# Timing model
The source footage, authored drawings, generated face motion, and stage placement
have different frame decisions. They share a clock but do not share one kept-frame
list. `timing-handoff.md` records earlier implementation notes.
## Frame spaces
- A source frame addresses a decoded image and its measured face data. Keep the
source cadence and, for variable-rate video, its presentation timestamp.
- A timeline frame addresses authored keys in the clip or symbol's local space.
- A stage frame is mapped through the symbol instance's offset and rate before
local frame decisions are read. Moving a placement does not rewrite its keys.
The analyzed source poses remain dense. A lower picture rate or a skipped pose
never removes source data or shortens audio.
## Head placement
Analysis fits each source frame's rigid landmarks into one common head-local
space. Its inverse is the measured head transform, stored densely on `:head`.
The head node has one optional anchor map:
```clojure
;; no :anchors free movement: read measured frame f at f
:anchors {0 12} ; one lock: use frame 12's transform throughout
:anchors {0 12, 40 42} ; keyed locks: switch to frame 42 at local frame 40
```
A key is `(local change frame -> measured source frame)`. Its value holds to the
next key. The map chooses position, rotation and scale together. Frame zero must
have a key when the map exists. The dense transform blocks remain intact, so
editing anchors is a small document change and re-freezing can replace the
measurements without losing the anchor choices.
A source image used for tracing should be registered with that image's measured
stabilizing transform, then the selected head transform, then the authored
`:face` placement. This makes the photo and head-local vectors share the same
orientation and position. Tracing-photo selection is a separate editor address;
it does not choose the head anchor.
The prototype stabilizes into the shot's mean rigid pose and uses an early
closed-mouth frame for raster framing. Those are internal analysis and framing
choices. The authored head-anchor map above controls which measured head pose is
shown over each range. It is independent of plate drawing starts.
## Performance poses
Generated mouth, eye, and brow channels can be sampled at a lower picture rate
without retiming authored keys. The normal rule picks the latest available pose
at or before a picture-grid time. A future performance policy may add important
closed-mouth poses and store manual keeps/drops separately from the rate's
proposal. Related parts should share a selected pose by default: a mouth outline,
interior, teeth and generated visibility must not disagree about its frame.
## Stage placement
A symbol placement has optional pose-cut tracks, separate from head anchors:
```clojure
:playback {:tracks {:mouth {0 12, 8 27}
:eye-r {0 0, 4 6}}}
```
These maps are also `(local change frame -> source pose frame)`. They select which
baked/generated shape pose appears on that placement. Before the first explicit
cut, normal generated motion continues. Cuts hold, without interpolation, until
the next cut. A `[:node id]` track can override one shape in a shared group.
Authored cels, transforms, and audio remain on their normal local time.
The current implementation reads retained frozen channels. A separate resolved
geometry bake is not implemented; when added, it must preserve addressable
candidate poses so stage cuts can still select any of them.
## Ownership
| Choice | Owner | Current state |
| --- | --- | --- |
| Source frames and timestamps | Footage/analysis | Constant-rate frame indexing exists; variable timestamps remain future work |
| Head anchor map | `:head` node | Implemented, stored with the node |
| Tracing cel starts and photo address | Authored cel | Separate future work |
| Generated picture-rate proposal and closure protection | Roto clip/symbol | Generated-only picture sampling exists; closure protection remains future work |
| Stage pose cuts | Symbol instance | Implemented, stored with the instance |
Preview and export use the same resolver for generated picture sampling and stage
cuts. Export still emits every timeline frame at the clip's audio rate.

55
frontend/README.md
View file

@ -92,19 +92,6 @@ Then open **<http://localhost:8778/>**. Django serves the page from
`static/arthur/js`, where `shadow-cljs` already writes it — so nothing copies files
between the two.
### 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
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
tween. Use the project **save** button to persist the drawings.
`/index.html` still works, and that is deliberate: it is the URL the browser suite
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.
@ -125,48 +112,21 @@ 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
`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
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.
### Projects and the EDN fixtures
The EDN files under `demo/` are authored examples compiled into the frontend.
They seed a clip in memory; the server does not read EDN. Clicking **save** on a
clip without a project id creates a project through `POST /api/projects`, uploads
any missing content-addressed blocks, then writes the clip's addressed leaves
through `PUT /api/projects/<id>`. Each leaf value is Transit JSON inside the
request's ordinary JSON envelope. Python stores those values in JSON columns and
does not need an EDN parser. **open** reads the leaves and blocks and rebuilds
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.
### Real footage
Choose a video in the **footage** file input. 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,
to a browser-seekable H.264 proxy, 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
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.
**The proxy is what gets measured, and the stills are not.** `flow/ingest` cuts
its raw H.264 stream into coded frames and decodes them in order with WebCodecs.
The proxy has no B-frames, so decode order matches frame order. `flow/detect`
hands each decoded frame to MediaPipe in **VIDEO** running mode at
`i * 1000 / fps` milliseconds. That timestamp has to increase
**The proxy is what gets measured, and the stills are not.** `flow/ingest` steps
the proxy one frame at a time — seek to `(i + 0.5) / fps`, wait for
`requestVideoFrameCallback`, check the `mediaTime` it reports is the frame that
was asked for — and `flow/detect` hands each frame to MediaPipe in **VIDEO**
running mode at `i * 1000 / fps` milliseconds. That timestamp has to increase
strictly and has to be real footage time: video mode is a tracker, it reads the
gap between timestamps as motion, and a repeat leaves the graph in an error state
that every later call re-throws. The JPEGs beside the proxy are reference images
@ -176,8 +136,7 @@ digest.
It is re-encoded even when the upload is already H.264, for two reasons: an
iPhone's HEVC is not decodable in every browser, and the footage's identity is the
proxy's digest — one produced by one ffmpeg invocation, not one that depends on
which branch the source happened to take. Its raw stream is copied from that
proxy without another encode.
which branch the source happened to take.
The command-line route is also available for an existing extracted bundle:

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

@ -1,170 +0,0 @@
(ns arthur.audio.mix
"Render independently placed audio tracks into one stage audio clock.
The mix is derived from saved audio track leaves and immutable footage blobs.
The transport still has one audio element, so seeking, rate changes and looping
stay tied to the same clock the picture reads.
THE AUDIO BUFFER IS THE PRODUCT AND THE WAV IS ONE PACKAGING OF IT. Playback
wants a URL an `<audio>` element can hold; an export wants the samples, either
as WAV bytes to put in an archive or as the `AudioBuffer` a muxer takes as an
audio track. So `buffer!` renders and the two wrappers below it package, rather
than the render being spelled once per consumer."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.node :as node]))
(defn wav-bytes
"An `AudioBuffer` -> the bytes of a 16-bit PCM WAV.
PEAK-NORMALISED ONLY IF IT WOULD CLIP. A mix of several tracks can sum past
1.0, and 16-bit PCM has nowhere to put that, so the alternative to scaling is
audible clipping on exactly the loudest moment. Below the threshold nothing is
touched, so a single-track mix is the footage's own audio sample for sample."
[^js buffer]
(let [channels (.-numberOfChannels buffer)
frames (.-length buffer)
rate (.-sampleRate buffer)
bytes (js/ArrayBuffer. (+ 44 (* frames channels 2)))
view (js/DataView. bytes)
samples (mapv #(.getChannelData buffer %) (range channels))
peak (reduce max 0
(for [channel samples i (range frames)]
(js/Math.abs (aget channel i))))
level (if (> peak 0.98) (/ 0.98 peak) 1)]
(doseq [[offset word] [[0 "RIFF"] [8 "WAVE"] [12 "fmt "] [36 "data"]]]
(dotimes [i 4] (.setUint8 view (+ offset i) (.charCodeAt word i))))
(.setUint32 view 4 (- (.-byteLength bytes) 8) true)
(.setUint32 view 16 16 true)
(.setUint16 view 20 1 true)
(.setUint16 view 22 channels true)
(.setUint32 view 24 rate true)
(.setUint32 view 28 (* rate channels 2) true)
(.setUint16 view 32 (* channels 2) true)
(.setUint16 view 34 16 true)
(.setUint32 view 40 (* frames channels 2) true)
(dotimes [i frames]
(dotimes [c channels]
(let [sample (* level (aget (get samples c) i))]
(.setInt16 view (+ 44 (* (+ (* i channels) c) 2))
(js/Math.round (* 32767 (max -1 (min 1 sample)))) true))))
(js/Uint8Array. bytes)))
(defn- wav-url [^js buffer]
(js/URL.createObjectURL
(js/Blob. #js [(wav-bytes buffer)] #js {:type "audio/wav"})))
(defn- source! [footage-id]
(-> (js/fetch (str "/api/footage/" footage-id))
(.then (fn [response]
(when-not (.-ok response)
(throw (ex-info "audio track's footage is missing"
{:footage footage-id :status (.-status response)})))
(.json response)))
(.then (fn [^js manifest]
(-> (js/fetch (.-audio manifest))
(.then (fn [response]
(when-not (.-ok response)
(throw (ex-info "audio track's blob is missing"
{:footage footage-id :status (.-status response)})))
(.arrayBuffer response)))
(.then (fn [bytes]
(let [decoder (js/OfflineAudioContext. 1 1 44100)]
(-> (.decodeAudioData decoder bytes)
(.then (fn [buffer]
[footage-id {:buffer buffer
:fps (.-fps manifest)}])))))))))))
(defn- automate! [^js param channel start end fps factor default store]
(let [channel (or channel (ch/framed default))]
(.setValueAtTime param (* factor (ch/value-at channel start store)) (/ start fps))
(cond
(:dense channel)
(doseq [f (range (inc start) end)]
(.setValueAtTime param (* factor (ch/value-at channel f store)) (/ f fps)))
(:animated? channel)
(doseq [[f v] (sort-by key (:keys channel))
:when (and (> f start) (< f end))]
(if (= :linear (:interp channel))
(.linearRampToValueAtTime param (* factor v) (/ f fps))
(.setValueAtTime param (* factor v) (/ f fps)))))))
(defn tracks-of
"The audio nodes of one of the clip's timelines.
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]
(let [fps (:fps document)
frames (:frames (clip/timeline document tid))
tracks (tracks-of document tid)
output (js/OfflineAudioContext.
2 (js/Math.ceil (* (/ frames fps) 44100)) 44100)]
(doseq [track tracks]
(let [[start end] (or (:span track) [0 frames])
start (max 0 start)
end (min frames end)
{:keys [buffer fps]} (get sources (get-in track [:source :footage]))
sound (.createBufferSource output)
gain (.createGain output)
pan (.createStereoPanner output)]
(when (< start end)
(set! (.-buffer sound) buffer)
(set! (.-loop sound) (boolean (get-in track [:time :loop?])))
(automate! (.-playbackRate sound)
(get-in track [:channels [:audio :rate]])
start end (:fps document) (or (get-in track [:time :rate]) 1) 1 store)
(automate! (.-gain gain)
(get-in track [:channels [:audio :gain]])
start end (:fps document) 1 1 store)
(automate! (.-pan pan)
(get-in track [:channels [:audio :pan]])
start end (:fps document) 1 0 store)
(.connect sound gain)
(.connect gain pan)
(.connect pan (.-destination output))
(.start sound (/ start (:fps document)) (/ (node/local-frame track start) fps))
(.stop sound (/ end (:fps document))))))
(.startRendering output)))
(defn buffer!
"Promise of the `AudioBuffer` one timeline'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)]
(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))))))))
(defn decode!
"Promise of the `AudioBuffer` behind a URL. What a clip whose audio is a plain
file rather than placed tracks exports."
[url]
(-> (js/fetch url)
(.then (fn [^js response]
(when-not (.-ok response)
(throw (ex-info "the clip's audio did not load"
{:url url :status (.-status response)})))
(.arrayBuffer response)))
(.then (fn [bytes]
(.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))))))

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

@ -6,7 +6,6 @@
(:require [arthur.db :as db]
[arthur.events.footage :as footage]
[arthur.events.playback]
[arthur.events.paint]
[arthur.events.project]
[arthur.subs.playback]
[arthur.subs.render]

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

@ -44,18 +44,14 @@
`:head` written as a dense track in one and as framed identity in the other, so
the button that switches between them switches a document field and nothing
else."
{:demo {:label "demo" :entry (delay (entry :demo "demo" demo/clip nil))}
:swarm {:label "swarm" :entry (delay (entry :swarm "swarm" @swarm/clip @swarm/store))}
:take {:label "take" :entry (delay (entry :take "take" @take/clip @take/store))}
:take-locked {:label "locked" :entry (delay (entry :take-locked "locked" @take/locked @take/store))}})
(defn clip-entry [id]
(some-> (get-in clips [id :entry]) deref))
{:demo (entry :demo "demo" demo/clip nil)
:swarm (entry :swarm "swarm" @swarm/clip @swarm/store)
:take (entry :take "take" @take/clip @take/store)
:take-locked (entry :take-locked "locked" @take/locked @take/store)})
(def default
{;; --- the document ---
:clip/current :take
:paint/revision 0
:palette :arthur/default ; a NAME; the ramp itself is project data
;; --- the clip ---
@ -64,7 +60,7 @@
;; 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 (select-keys (:take clips) [:fps :frames :width :height :audio :display-fps])
;; 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
@ -90,15 +86,6 @@
;; how scrubbing becomes inspectable in re-frame-10x, and a collaborator's
;; playhead is a feature — putting it outside app-db puts it outside the
;; machinery that would share it.
;; --- export ---
;;
;; The REQUEST and its progress, never the frames. Which timeline 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
:status nil}
:playback {:frame 0
:playing? false
:rate 1.0

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

@ -1,73 +0,0 @@
(ns arthur.demo.stage
"A saved take placed seven times on a stage. The EDN is the authored layout."
(:require [arthur.domain.channel :as ch]
[cljs.reader :as reader]
[shadow.resource :as rc]))
(def layout (reader/read-string (rc/inline "arthur/demo/stage_8625.edn")))
(defn- position-track [center anchor drift phase frames]
(let [base (mapv - center anchor)
[dx dy] drift
wave (fn [f period] (js/Math.sin (* 2 js/Math.PI (/ (+ f phase) period))))
x0 (wave 0 96)
y0 (wave 0 132)]
(ch/keyed
(into {}
(for [f (conj (vec (range 0 frames 20)) (dec frames))]
[f [(+ (first base) (* dx (- (wave f 96) x0)))
(+ (second base) (* dy (- (wave f 132) y0)))]]))
:linear)))
(defn compose
"The authored layout plus a source clip -> the composed stage document.
A PLACEMENT IS KEYED BY ITS :uuid, not by the authored id. The authored id
(`:left`, `:voice-right`) is a handle for reading the EDN and for the
`:linked-to` written there; it does not appear in the document this returns.
What replaces it is an identity that means one placement and nothing else: seven
instances of one symbol are seven different things to name — to export on their
own, to link a voice to, to point at later — and an id like `:left` is a
description of where a thing sits, which is exactly what changes when the stage
is re-arranged. `:name` carries the label for a human and `:of` carries the
symbol, so the node still says what it is and which drawing it plays."
[source]
(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])
;; 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.
by-id (into {} (map (juxt :id :uuid)) (concat instances audio))
uuid-of (fn [what id]
(or (get by-id id)
(throw (ex-info "the stage layout names a placement that is not there"
{:in what :id id
: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]}]
(let [anchor (or anchor default-anchor)]
[uuid {:id uuid :name name :kind :symbol :of symbol
:parent :root :z z :span span
:time {:mode :map :at at :in in :rate 1}
:channels {[:xform :pos] (if drift
(position-track center anchor drift phase frames)
(ch/framed (mapv - center anchor)))
[:xform :anchor] {:animated? false :value anchor}
[:xform :scale] scale}}]))
instances))
nodes (into nodes
(map (fn [{:keys [uuid linked-to z source span at in 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}
:channels (cond-> {[:audio :gain] gain}
pan (assoc [:audio :pan] pan))}])
audio))]
(assoc source :name name :width width :height height
:timelines (assoc (:timelines source)
:main {:id :main :frames frames :nodes nodes}
symbol (assoc original :id symbol)))))

77
frontend/src/arthur/demo/stage_8625.edn
View file

@ -1,77 +0,0 @@
;; A local stage sketch. The source is the saved, post-processed IMG_8625.MOV
;; clip in the project store; its dense channel blocks are shared by all seven
;; instances. Centers, drift and timing are authored in stage pixels and frames.
{:source-project "4379f900-bdd2-409b-acf6-32081f8ce01f"
:source-cid "f8cace9e-4ad3-4796-973c-c62eeebe3d01"
:symbol :sym/face-8625
:name "8625 stage study"
:width 320 :height 200 :frames 280
;; Each :center below places the source clip's center on the stage. A symbol
;; can author :anchor to override that default for an off-center drawing.
;; Each placement reads this pulse in its own local time, so the staggered
;; entrances start their growth at different moments on the master timeline.
:scale {:animated? true :interp :linear
:keys {0 [0.4 0.4], 12 [0.56 0.56], 24 [0.48 0.48],
48 [0.52 0.52], 72 [0.48 0.48], 96 [0.52 0.52],
120 [0.48 0.48], 144 [0.52 0.52], 168 [0.48 0.48],
192 [0.52 0.52], 216 [0.48 0.48], 240 [0.52 0.52],
279 [0.48 0.48]}
:over []}
;; Audio placements are ordinary timeline nodes with channel parameters.
;; :linked-to is an editorial link; their spans and time maps are independent.
: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
: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
: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}
:over []}
:pan {:animated? true :interp :linear
:keys {48 -0.8, 90 -0.8, 130 0.7, 175 0.7, 220 -0.65, 259 0.65}
:over []}}]
;;
;; EVERY PLACEMENT CARRIES A :uuid, and it is authored here rather than generated
;; in `compose`. The uuid is the node's identity in the composed document — it is
;; the key in the timeline's node map — so generating one per load would give the
;; same stage a different document on every load, and nothing that refers to a
;; placement (`:linked-to` above, an export target in the UI, a comment in a
;; review) could survive a reload. The `:id` beside it stays as the AUTHORING
;; handle: it is what the reader of this file uses to see which placement is
;; which, and what the `:linked-to` above names, and `compose` resolves it to the
;; uuid. Nothing downstream of `compose` sees the authored id.
:instances
[{:id :left :uuid #uuid "ee7321c8-faf1-46d7-8029-37771898accb"
:name "8625 left" :z "a1"
:span [0 280] :at 0 :in 0
: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
: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
: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
: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
: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
: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
:center [250 135] :drift [2 2] :phase 107}]}

18
frontend/src/arthur/demo/take.cljs
View file

@ -21,9 +21,11 @@
anything that reads a source pixel, because that part takes the landmarks and
the frames and never the transform.
TWO CLIPS, ONE STORE. `:take` reads each measured head transform in time;
`:take-locked` holds the measured transform from frame zero. They share the
same dense blocks; only the head node's anchor map differs."
TWO CLIPS, ONE STORE. `:take` carries the head as filmed and `:take-locked`
carries it locked, and they are the same dense blocks with one node's channels
written two ways. That is the claim \"stabilisation is a channel, not a mode\"
made checkable by eye: switching between them is a document edit, tier 1, and
not one byte of tier 2 differs."
(:require [arthur.flow.address :as address]
[arthur.flow.freeze :as freeze]
[arthur.flow.take :as take]
@ -72,7 +74,7 @@
:expose 2
;; The head as filmed. `:take-locked` is the same freeze with this one
;; field changed, which is the point.
:head :free
:head :as-filmed
;; Provenance, and now a content address. There is no detector here, so
;; the generator IS the detector and its seed is the source: two synth
;; takes at different seeds are different analyses, which is the same
@ -84,15 +86,13 @@
:fps fps
:aspect aspect})}))
(def subject :face-1)
(def frozen
(delay (freeze/clip params {subject @measured})))
(delay (freeze/clip params @measured)))
(def store (delay (:store @frozen)))
(def clip (delay (:clip @frozen)))
(def locked
"The same blocks, with `:head` held at measured frame zero."
(delay (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen)))
"The same blocks, with `:head` written as framed identity instead."
(delay (freeze/head-mode {:mode :locked} @frozen)))

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

@ -92,9 +92,12 @@
(vec (sort (keys ks)))))
(defn- check-unimplemented!
"An override layer must fail LOUDLY rather than be ignored.
"An override layer or a retimed symbol instance must fail LOUDLY rather than
be ignored.
Silently dropping an :over layer would present as a hand
Both are specified in docs/animation-model.md and neither is built yet
(port-plan scope: \"leave the :over field present and empty; leave :symbol out
entirely\"). Silently dropping an :over layer would present as a hand
correction that did not take — a correction the user made once, watched fail,
and has no reason to trust again. Nothing can produce one yet, so this can
only fire on a data shape that has run ahead of the code."
@ -169,22 +172,6 @@
;; ---------------------------------------------------------------------------
;; the specification
(defn segment-interp
"How the key at `left` leads to the next key. A channel default remains useful
for uniform tracks; :segments overrides only the gaps an artist chose."
[ch left]
(get (:segments ch) left (:interp ch)))
(defn- interpolate [ch f left right]
(let [a (get (:keys ch) left)]
(if (and (= :linear (segment-interp ch left)) right (>= f left) (> right left))
(let [b (get (:keys ch) right)
t (/ (- f left) (- right left))]
(if (vector? a)
(mapv (fn [x y] (+ x (* t (- y x)))) a b)
(+ a (* t (- b a)))))
a)))
(defn- keyed-at
"The most recent key at or before f, CLAMPED to the first key below it.
@ -193,11 +180,11 @@
frame before it reads that pose rather than having no value. This is not the
same question as presence — a part with no value at all is `absent`, which is
a state bit, not an empty key map."
[ch f]
(let [fr (sort (keys (:keys ch)))
left (or (last (take-while #(<= % f) fr)) (first fr))
right (first (drop-while #(<= % f) fr))]
(interpolate ch f left right)))
[ks f]
(let [fr (sort (keys ks))]
(if-let [hit (last (take-while #(<= % f) fr))]
(get ks hit)
(get ks (first fr)))))
(defn value-at
"Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and
@ -209,7 +196,7 @@
(not (:animated? ch)) (:value ch)
(:dense ch) (dense-at (:dense ch) f store)
(:keys ch) (let [ks (:keys ch)]
(if (empty? ks) absent (keyed-at ch f)))
(if (empty? ks) absent (keyed-at ks f)))
:else
(throw (ex-info "animated channel has neither :keys nor :dense" {:channel ch})))))
@ -285,7 +272,7 @@
:else (bsearch ks f))]
(set! (.-i cur) i')
(interpolate ch f (nth ks i') (when (< i' last) (nth ks (inc i'))))))))
(get (:keys ch) (nth ks i'))))))
;; ---------------------------------------------------------------------------
@ -300,18 +287,7 @@
(defn problems
"Human-readable reasons this map is not a channel. Empty means it is one."
[ch]
(let [values (when (map? (:keys ch)) (vals (:keys ch)))
first-value (first values)
linear-values? (or (every? number? values)
(and (vector? first-value)
(pos? (count first-value))
(every? (fn [v] (and (vector? v)
(= (count v) (count first-value))
(every? number? v)))
values)))
linear? (or (= :linear (:interp ch))
(some #{:linear} (vals (:segments ch))))]
(cond-> []
(cond-> []
(not (map? ch))
(conj "not a map")
@ -331,19 +307,9 @@
(and (map? ch) (:keys ch) (map? (:keys ch)) (not (every? number? (keys (:keys ch)))))
(conj ":keys has a non-numeric frame")
(and (map? ch) (:animated? ch) (not (#{:hold :linear nil} (:interp ch))))
(conj (str ":interp " (:interp ch) " is not implemented"))
(and (map? ch) (contains? ch :segments)
(or (not (map? (:segments ch)))
(not (:keys ch))
(not (every? (set (keys (:keys ch))) (keys (:segments ch))))
(not (every? #{:hold :linear} (vals (:segments ch))))))
(conj ":segments must map existing key frames to :hold or :linear")
(and (map? ch) linear?
(or (:dense ch) (not linear-values?)))
(conj ":linear interpolation needs numeric keys of one shape")
(and (map? ch) (:animated? ch) (not (#{:hold nil} (:interp ch))))
(conj (str ":interp " (:interp ch) " — only :hold is implemented; docs/design.md"
" requires hold of every cut part and tweening reads as puppet software"))
(and (map? ch) (seq (:over ch)))
(conj ":over layers are not implemented (port-plan step 2 scope)")
@ -355,4 +321,5 @@
(not (and (number? (:scale (:dense ch))) (pos? (:scale (:dense ch))))))
(conj (str ":dense :scale is " (pr-str (:scale (:dense ch)))
" — a fixed-point scale is a positive number the stored integers"
" were multiplied by")))))
" were multiplied by"))))

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

@ -19,8 +19,9 @@
structure with the same `:nodes` key that every walk had to be taught about.
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.
a MAP of them. `:kind :symbol` is still unimplemented and this is the shape it
was waiting for: an instance names a timeline in `:timelines`, and the resolver
recurses into a type it already knows how to evaluate.
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
@ -34,9 +35,6 @@
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."
(: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
@ -83,82 +81,14 @@
[clip]
(:nodes (root clip)))
(defn- transform-op
"Put a symbol's already resolved mark into its instance's parent space."
[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)))]
(case (:kind op)
:poly (let [out (js/Float64Array. (.-length (:pts op)))]
(dotimes [i (:n op)]
(let [[x y] (at (aget (:pts op) (* 2 i))
(aget (:pts op) (inc (* 2 i))))]
(aset out (* 2 i) x)
(aset out (inc (* 2 i)) y)))
(assoc op :pts out))
:disc (let [[x y] (at (:cx op) (:cy op))]
(assoc op :cx x :cy y :r (* scale (:r op))))
:rect (let [[x y] (at (:cx op) (:cy op))]
(assoc op :cx x :cy y :size (* scale (:size op))))
op)))
(defn resolver
"Resolve a clip, including each library timeline placed by a symbol instance.
Each instance owns its own timeline 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.
`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))
ids (sort-by rank (keys nodes))
own (timeline/resolver tl 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)
(get-in n [:playback :tracks]))]))]
(fn [f]
(let [by-id (into {} (map (juxt :node identity)) (own f))]
(into []
(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))
length (:frames target)
frame (when (and m (number? local))
(if (get-in n [:time :loop?])
(mod local length)
local))]
(if (and frame (<= 0 frame) (< frame length))
(map #(transform-op % m [id]) ((get children id) frame))
[]))
(when-let [op (get by-id id)] [op]))))
ids))))))]
(build root [] nil))))
(defn problems
"Human-readable reasons this clip will not evaluate or save."
"Human-readable reasons this clip will not evaluate or will not save. Empty
means it will.
The tracking identities are checked HERE and not in `domain/timeline`, because a
feature names nodes and only the root timeline's nodes were tracked into: a
library symbol is drawn, not detected. So `feature/problems` is asked about the
root, once, rather than about every timeline."
[clip]
(vec
(concat
@ -176,29 +106,5 @@
(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)])
active (filter (fn [node]
(some :pose-sampled? (vals (:channels node))))
(vals (:nodes target)))
groups (set (concat
(map #(or (:pose-group %) (:id %)) active)
(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)
:when (and (= :audio (:kind n)) (:linked-to n)
(not (contains? (:nodes tl) (:linked-to n))))]
(str "timeline " (pr-str tid) " audio " (pr-str id)
" links to missing node " (pr-str (:linked-to n))))
(feature/problems clip))))
(when (map? (root clip))
(feature/problems clip (nodes clip))))))

47
frontend/src/arthur/domain/crc32.cljs
View file

@ -1,47 +0,0 @@
(ns arthur.domain.crc32
"CRC-32, as PNG chunks and ZIP entries both define it.
ONE implementation for both, and that is not premature sharing: a PNG chunk's
trailing checksum and a ZIP local header's `crc-32` field are the same function
of the same bytes — IEEE 802.3, reflected, with an initial and final complement
— down to the polynomial. Two copies would be two chances to get the table
wrong in a way that reads as \"the file is corrupt\" rather than as \"these two
functions disagree\".
It lives beside `domain/sha256` for the same reason that one does: a digest is
a pure function of bytes with no DOM in it, so every assertion about it runs
under node.")
(def ^:private table
;; The standard 256-entry table, built once. The bit-twiddling loop IS the
;; definition of the polynomial and there is no collection idiom hiding in it:
;; each entry is eight dependent shifts of one accumulator.
(let [t (js/Uint32Array. 256)]
(dotimes [n 256]
(aset t n (loop [c n k 0]
(if (= k 8)
c
(recur (if (odd? c)
(bit-xor 0xedb88320 (unsigned-bit-shift-right c 1))
(unsigned-bit-shift-right c 1))
(inc k))))))
t))
(defn of
"CRC-32 of a byte array, or of the half-open range [from to) of one, as an
unsigned 32-bit number.
`loop` over the bytes rather than a reduce over a `range`: this walks the whole
of every PNG written, which at 1920x1200 is seven megabytes a frame, and a seq
cell per byte is the allocation the rest of this codebase is arranged to
avoid."
([bytes] (of bytes 0 (.-length bytes)))
([bytes from to]
(-> (loop [c 0xffffffff i from]
(if (>= i to)
c
(recur (bit-xor (aget table (bit-and (bit-xor c (aget bytes i)) 0xff))
(unsigned-bit-shift-right c 8))
(inc i))))
(bit-xor 0xffffffff)
(unsigned-bit-shift-right 0))))

35
frontend/src/arthur/domain/feature.cljs
View file

@ -1,12 +1,13 @@
(ns arthur.domain.feature
"Tracked subjects, feature ownership, and eye-pair settings.
Features name their timeline explicitly; node ids are local to that timeline."
(:require [arthur.domain.params :as params]))
"Stable tracked identities and explicit eye-pair settings associations.
(defn owned
"A deterministic clip-level feature or group id. Nodes keep local names."
[subject role]
(keyword (subs (str subject) 1) (name role)))
These maps are the CLIP's — `:subjects`, `:features`, `:groups` — and not a
timeline's, because they describe what a camera saw and a library symbol is
drawn rather than detected. Rendering never reads them; it reads nodes and
channels. `problems` therefore takes the clip AND the node map to check
references against, rather than reaching for `(:nodes clip)`: a clip holds
several timelines and only the root one was tracked into."
(:require [arthur.domain.params :as params]))
(defn group-for [clip feature-id]
(first (filter (fn [[_ group]] (some #{feature-id} (:members group)))
@ -44,14 +45,17 @@
clip))
(defn problems
"Check tracked identities and timeline-local node ownership."
[clip]
"Check identity references and pair membership before storing a clip.
`nodes` is the node map a feature's `:nodes` are resolved against — the root
timeline's, passed in rather than looked up, so this namespace does not have to
know which timeline a clip plays."
[clip nodes]
(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])]
node-owners (mapcat (comp :nodes val) features)]
(vec
(concat
(for [[id s] subjects :when (not= id (:id s))]
@ -59,9 +63,6 @@
(for [[id s] subjects
: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"))
(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)))]
@ -71,12 +72,8 @@
(for [[id f] features
: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"))
(for [[id f] features node-id (:nodes f)
:let [owned-nodes (get-in clip [:timelines (:timeline f) :nodes])]
:when (not (contains? owned-nodes node-id))]
:when (not (contains? 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)]
(str "node " (pr-str id) " belongs to more than one feature"))

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

@ -44,9 +44,7 @@
WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are
not authored: they are written together by a freeze and replaced together by a
re-freeze, and `head-mode` exposes them through `:channels`. The optional
`:anchors` map on the head node chooses which measured frame those channels
read. A leaf per measured
re-freeze, and `head-mode` reads them to write `:channels`. A leaf per measured
channel would offer a write nobody can make. The authored channels beside them
are one leaf each, because a hand writes one at a time.
@ -71,27 +69,10 @@
{:id id})))
(str/replace s "/" "~")))
(def ^:private uuid-segment
"Canonical UUID form: 8-4-4-4-12 hex digits, and nothing else.
A PLACEMENT'S ID IS A UUID — see `demo/stage/compose` for why — and a leaf path
is text, so reading one back has to decide which ids are uuids and which are
keywords. It decides by SHAPE, which is a judgement worth stating: a keyword
that happened to be thirty-six characters of hex in exactly this grouping would
come back a uuid. Nothing names a node that by hand, and the alternative — a
sigil on every segment — would change the shape of every path in every leaf to
disambiguate a case that does not arise. `^` and `$` are the load-bearing part;
without them a longer id CONTAINING a uuid would match."
#"^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$")
(defn unsegment
"One path segment -> the id it names: a uuid when it is shaped like one, a
keyword otherwise."
"One path segment -> the id it names."
[s]
(let [s (str/replace s "~" "/")]
(if (re-find uuid-segment s)
(uuid s)
(keyword s))))
(keyword (str/replace s "~" "/")))
(defn- prop->path
"A channel's property vector -> one path segment. `[:geom :pts]` is \"geom.pts\"

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

@ -18,12 +18,12 @@
(:require [arthur.domain.channel :as ch]))
(def kinds
"`:bitmap` is in the vocabulary and not implemented; it is
"`:symbol` and `:bitmap` are in the vocabulary and not implemented; they are
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 :symbol})
(def implemented-kinds #{:poly :disc :rect :group :symbol :audio})
(def implemented-kinds #{:poly :disc :rect :group})
(def xform-paths
"In composition order, which is also the order they have to be sampled in.
@ -45,8 +45,6 @@
change to this spec silently change what gets drawn."
(let [base (into #{[:vis]} xform-paths)]
{:group base
:symbol 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
;; performance — but it is a channel like any other so it can be keyed.
@ -117,20 +115,22 @@
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]
(let [{:keys [mode offset rate 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"
;; A symbol instance's (f - at)·rate + in is the third face of this
;; mechanism and symbols are out of scope. Loud rather than ignored: a
;; silently dropped rate is a retimed blink playing at the wrong speed,
;; which looks like a bad blink and not like a missing feature.
(when (and rate (not= rate 1.0) (not= rate 1))
(throw (ex-info "time map :rate is symbol timing and symbols are not built (port-plan step 2 scope)"
{: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)
(cond-> f
sample-fps (sample-frame source-fps sample-fps)
ex (expose ex)
offset (+ offset))))))
@ -265,12 +265,6 @@
(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 :audio) (nil? (get-in n [:source :footage])))
(conj "an audio instance needs :source :footage")
(and (#{:symbol :audio} k) (some? (get-in n [:time :rate]))
(not (pos? (get-in n [:time :rate]))))
(conj "an instance's :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]"))

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

@ -1,57 +0,0 @@
(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."
(:require [arthur.domain.channel :as channel]))
(def geometry [:geom :pts])
(defn shapes [clip]
(->> (get-in clip [:timelines :main :nodes])
(filter (fn [[_ node]] (:paint? node)))
(sort-by (comp :z val))
vec))
(defn active-frame [ch frame]
(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])
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))))
: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]
node (get-in clip path)
ch (get-in node [:channels geometry])
[start end] (:span node)]
(if (and (:paint? node) (<= start frame) (< frame end) ch)
(assoc-in clip (into path [:channels geometry :keys frame])
(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]
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])
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
:segments key-frame] interp)
clip)))

149
frontend/src/arthur/domain/png.cljs
View file

@ -1,149 +0,0 @@
(ns arthur.domain.png
"An indexed raster -> one PNG, at integer zoom.
THE EXPORT'S MASTER FORMAT, and the reasons are all about not resampling.
Everything above `domain/raster` exists to put hard-edged flat fills into a
byte buffer; a lossy encoder would put chroma fringes on exactly the edges the
whole idiom is made of, and a fractional scale would put grey on them. So the
picture leaves the tool as PNG, and it leaves it at an INTEGER zoom — a pixel
becomes a block of identical pixels and nothing is interpolated.
TRUECOLOUR, NOT PALETTED, and that is a deliberate loss. Colour type 3 would be
the faithful shape — the buffer IS palette indices and a PLTE chunk is the ramp
— and it would be a third of the bytes into deflate. But the entire purpose of
this file is to be imported by a program we cannot test against here, and
type 2 is the type every reader on earth handles. Faithfulness that depends on
someone else's PNG decoder being complete is not faithfulness. The pixels are
identical either way; only the file is bigger, and deflate takes most of that
back because the art is flat.
`CompressionStream` does the deflating, which is why `encoder` hands back a
promise. It is the zlib-wrapped variety — RFC 1950, which is what an IDAT
requires — and getting that wrong is a one-word difference from `deflate-raw`
and a file no reader will open.
No DOM. A canvas `toBlob` would be shorter and would put this namespace out of
reach of node, where the rest of the rasteriser is asserted about; it would also
hand the encoding decisions to the browser, and the point of this file is that
they are decisions."
;; A `chunk` is the format's own word for its one structural unit, and chunked
;; seqs never come up in here, so core's loses the name rather than ours.
(:refer-clojure :exclude [chunk])
(:require [arthur.domain.crc32 :as crc32]))
(def ^:private signature
(js/Uint8Array. #js [0x89 0x50 0x4e 0x47 0x0d 0x0a 0x1a 0x0a]))
(defn- u32! [^js bytes at n]
(aset bytes at (bit-and (unsigned-bit-shift-right n 24) 0xff))
(aset bytes (+ at 1) (bit-and (unsigned-bit-shift-right n 16) 0xff))
(aset bytes (+ at 2) (bit-and (unsigned-bit-shift-right n 8) 0xff))
(aset bytes (+ at 3) (bit-and n 0xff)))
(defn chunk
"One PNG chunk: length, type, payload, CRC over type and payload.
Big-endian throughout, which is the format's and not the machine's — the same
reason `domain/raster/->rgba` has to ask which way round the machine is and this
does not."
[tag ^js payload]
(let [n (.-length payload)
out (js/Uint8Array. (+ n 12))]
(u32! out 0 n)
(dotimes [i 4] (aset out (+ 4 i) (.charCodeAt tag i)))
(.set out payload 8)
(u32! out (+ 8 n) (crc32/of out 4 (+ 8 n)))
out))
(defn- ihdr [w h]
(let [p (js/Uint8Array. 13)]
(u32! p 0 w)
(u32! p 4 h)
(aset p 8 8) ; bit depth
(aset p 9 2) ; colour type 2: truecolour RGB
(aset p 10 0) ; deflate, the only compression PNG has
(aset p 11 0) ; adaptive filtering, the only method
(aset p 12 0) ; no interlace
p))
(defn- deflate!
"Promise of the zlib stream of `bytes`.
`CompressionStream` rather than a deflate implementation: it is in every browser
this tool runs in and in node, so the one thing here that would be hundreds of
lines is none of them."
[^js bytes]
;; `.stream` first: `pipeThrough` is a ReadableStream's method, not a Blob's.
(-> (js/Response. (.pipeThrough (.stream (js/Blob. #js [bytes]))
(js/CompressionStream. "deflate")))
(.arrayBuffer)
(.then #(js/Uint8Array. %))))
(defn- concat!
[parts]
(let [out (js/Uint8Array. (transduce (map #(.-length ^js %)) + 0 parts))]
(reduce (fn [at ^js part] (.set out part at) (+ at (.-length part))) 0 parts)
out))
(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`
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
thrash, and it is the same buffer every frame because the stage is.
FILTER TYPE 2 (Up) ON EVERY ROW, including the first, where PNG defines the
prior row as zeros and Up therefore degenerates to None. It is chosen for the
zoom: at zoom 4 three of every four output rows are byte-identical to the one
above, so Up turns them into runs of zeros and deflate takes them to almost
nothing. Paletted or not, that is where the size of an upscaled flat-fill frame
goes."
[w h zoom]
(let [zoom (max 1 (js/Math.floor zoom))
out-w (* w zoom)
out-h (* h zoom)
stride (* out-w 3)
;; One filter byte per output row, then the filtered row.
raw (js/Uint8Array. (* out-h (inc stride)))
;; The row as it actually is, kept because Up filters against the
;; UNFILTERED row above, not against the stored bytes.
cur (js/Uint8Array. stride)
prev (js/Uint8Array. stride)
head (concat! [signature (chunk "IHDR" (ihdr out-w out-h))])
tail (chunk "IEND" (js/Uint8Array. 0))]
(fn [{:keys [buf] :as _raster} ramp]
;; The ramp is read as a flat byte table for the same reason ->rgba reads
;; one: `nth` into a vector of vectors is four protocol dispatches a pixel,
;; and this walks every pixel of every frame.
(let [p8 (js/Uint8Array. (* 256 3))]
(dotimes [i 256]
(let [c (or (nth ramp i nil) [255 0 255])]
(aset p8 (* i 3) (nth c 0))
(aset p8 (+ 1 (* i 3)) (nth c 1))
(aset p8 (+ 2 (* i 3)) (nth c 2))))
(.fill prev 0)
(dotimes [y h]
(let [srow (* y w)]
;; Expand one SOURCE row through the ramp once, repeating each pixel
;; `zoom` times across.
(dotimes [x w]
(let [p (* 3 (aget buf (+ srow x)))
r (aget p8 p) g (aget p8 (+ p 1)) b (aget p8 (+ p 2))]
(dotimes [k zoom]
(let [o (* 3 (+ (* x zoom) k))]
(aset cur o r)
(aset cur (+ o 1) g)
(aset cur (+ o 2) b)))))
;; …and emit it `zoom` times down. The second and later copies filter
;; to all zeros, which is the whole point of Up here.
(dotimes [k zoom]
(let [at (* (+ (* y zoom) k) (inc stride))]
(aset raw at 2)
(dotimes [i stride]
(aset raw (+ at 1 i)
(bit-and (- (aget cur i) (aget prev i)) 0xff)))
(.set prev cur)))))
(-> (deflate! raw)
(.then (fn [z] (concat! [head (chunk "IDAT" z) tail]))))))))

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

@ -1,94 +0,0 @@
(ns arthur.domain.pose
"An instance's explicit, held choices of source pose for each shape group.
A track is {local-frame -> source-frame}. The key is when the cut happens;
the value is the frozen pose to read. Skipped source frames remain available.")
(defn prepare
"Sort exposure tracks once when building a resolver."
[tracks]
(into {}
(map (fn [[group entries]]
[group (vec (sort-by first entries))]))
tracks))
(defn held-frame
"Last value keyed at or before f, or default before the first key."
[entries f default-frame]
(loop [lo 0 hi (dec (count entries)) hit nil]
(if (> lo hi)
(if (some? hit) (second (nth entries hit)) default-frame)
(let [mid (bit-shift-right (+ lo hi) 1)]
(if (<= (first (nth entries mid)) f)
(recur (inc mid) hi mid)
(recur lo (dec mid) hit))))))
(defn source-frame
"Read an explicit cut if one has happened; otherwise read the default pose.
This keeps the existing motion before the first edited cut."
[prepared group f default-frame]
(if-let [entries (get prepared group)]
(held-frame entries f default-frame)
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)
active (filter (fn [n] (some :pose-sampled? (vals (:channels n))))
(vals (:nodes symbol)))
groups (set (map #(or (:pose-group %) (:id %)) active))
ids (set (map :id active))]
(when-not (and (= :symbol (:kind node))
(or (contains? groups group)
(and (vector? group) (= 2 (count group))
(= :node (first group))
(contains? ids (second group))))
(integer? at) (<= 0 at) (< at length)
(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]
#(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]]
(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]
dissoc group))
clip)))
(defn problems
"Errors in one symbol instance's exposure tracks."
[tracks source-frames groups]
(cond
(nil? tracks) []
(not (map? tracks)) [":playback :tracks must be a map"]
:else
(vec
(mapcat
(fn [[group entries]]
(cond
(not (contains? groups group))
[(str "pose track " (pr-str group) " names no generated shape")]
(not (map? entries))
[(str "pose track " (pr-str group) " must map local frames to source frames")]
:else
(concat
(when-not (every? #(and (integer? %) (<= 0 %)
(or (nil? source-frames) (< % source-frames)))
(keys entries))
[(str "pose track " (pr-str group) " has an invalid change frame")])
(when-not (every? #(and (integer? %) (<= 0 %)
(or (nil? source-frames) (< % source-frames)))
(vals entries))
[(str "pose track " (pr-str group) " names a pose outside the source")]))))
tracks))))

9
frontend/src/arthur/domain/raster.cljs
View file

@ -134,11 +134,10 @@
breathing."
([r cx cy size index] (fill-rect! r cx cy size index nil))
([{:keys [w h buf] :as r} cx cy size index over]
(let [size (js/Math.round size)]
(when (>= size 1)
(let [x0 (js/Math.round (- cx (/ size 2)))
y0 (js/Math.round (- cy (/ size 2)))
ya (max 0 y0) yb (min h (+ y0 size))
(when (>= size 1)
(let [x0 (js/Math.round (- cx (/ size 2)))
y0 (js/Math.round (- cy (/ size 2)))]
(let [ya (max 0 y0) yb (min h (+ y0 size))
xa (max 0 x0) xb (min w (+ x0 size))]
(dotimes [iy (- yb ya)]
(dotimes [ix (- xb xa)]

95
frontend/src/arthur/domain/timeline.cljs
View file

@ -55,7 +55,6 @@
fill in the same channel rather than convert into a second format."
(:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node]
[arthur.domain.pose :as pose]
[arthur.domain.palette :as pal]))
;; ---------------------------------------------------------------------------
@ -271,14 +270,18 @@
:rd rd})))))))
(defn- emit
"Emit geometry in the timeline's space. Rect sizes stay fractional until
rasterization, so enclosing symbol transforms can still scale them."
"The draw op for a placed node, or nil when it has nothing to draw. A group
never draws; it exists to carry a transform.
Three branches that rhyme, deliberately left as three: a poly writes vertices
into a buffer it was handed, a disc carries a scaled radius, a rect a rounded
pixel count. They are three different marks, and the shared skeleton is two
cheap lines each — folding them into one shape driven by a table would buy
those lines back by coupling this to whatever the table was for."
[{:keys [palette buf-for]} n {:keys [m rd]} base]
(let [colour #(colour-index palette (rd [:style :color]))]
(case (:kind n)
:group nil
:symbol nil
:audio nil
:poly
(let [pts (rd [:geom :pts])]
@ -304,7 +307,10 @@
(when-not (ch/nothing? size)
(assoc base :kind :rect
:cx (aget m 4) :cy (aget m 5)
:size (* size (node/mean-scale m))
;; ROUNDED, because :size is a pixel count: a scaled square
;; 3.4px wide would be 3px on one frame and 4 on the next,
;; which reads as the pupil breathing. See raster/fill-rect!.
:size (js/Math.round (* size (node/mean-scale m)))
:color (colour))))
(throw (ex-info "node kind is not implemented"
@ -327,28 +333,6 @@
{:keys (vec (sort-by str (keys tl)))})))
nodes))
(defn- channel-frame
"Anchors select measured frames; marked channels read instance pose choices."
[choices anchors nodes source-fps picture-fps id c lf]
(cond
(contains? anchors id)
(pose/held-frame (get anchors id) lf lf)
(:pose-sampled? c)
(pose/source-frame choices
(if (contains? choices [:node id])
[:node id]
(or (:pose-group (get nodes id)) id))
lf
(node/sample-frame lf source-fps picture-fps))
:else lf))
(defn- prepared-anchors [nodes]
(into {}
(for [[id n] nodes :when (seq (:anchors n))]
[id (vec (sort-by first (:anchors n)))])))
(defn- eval-into
"One frame, as a fold over the nodes in topological order.
@ -372,8 +356,7 @@
(if (and pid (nil? parent))
acc
(if-let [p (place ctx n parent f)]
(let [_ (when-let [on-place (:on-place ctx)] (on-place id p))
op (emit ctx n p {:node id :stencil (:stencil n)})]
(let [op (emit ctx n p {:node id :stencil (:stencil n)})]
(cond-> (update acc :placed assoc id p)
op (update :ops conj op)))
acc))))
@ -395,17 +378,10 @@
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]
([tl f store palette]
(let [nodes (nodes-of tl)
choices (pose/prepare pose-tracks)
anchors (prepared-anchors nodes)
{:keys [source-fps picture-fps]} opts
ord (order nodes)]
(eval-into {:read (fn [id path c lf]
(ch/value-at c (channel-frame choices anchors nodes
source-fps picture-fps id c lf)
store))
(eval-into {:read (fn [_id _path c lf] (ch/value-at c lf store))
:palette palette
:mat-for (fn [_id] (node/mat))
:pinv-for (fn [id] (node/pinv (get nodes id)))
@ -442,8 +418,7 @@
A registered photo underlay has to ride the same transform the vectors went
through or it is merely decorative, and it paints immediately after the frame
it belongs to, so \"as of the last frame\" is the only answer that can be
correct.")
(frame-of [this id] "The placed node's local frame on the last resolve."))
correct."))
(defn resolver
"(fn [f] -> ops). Holds everything that does not change per frame.
@ -456,14 +431,10 @@
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]}]
([tl] (resolver tl nil pal/index-of))
([tl store] (resolver tl store pal/index-of))
([tl store palette]
(let [nodes (nodes-of tl)
choices (pose/prepare pose-tracks)
anchors (prepared-anchors nodes)
ord (order nodes)
rank (draw-rank nodes ord)
cursors (into {}
@ -484,26 +455,21 @@
;; it is how the resolver learns which nodes exist this frame without
;; eval-into having to report it — and it covers groups, which are
;; placed but emit no op, and which are exactly what an underlay rides.
placed (volatile! {})
ctx {:read (fn [id path c lf]
(ch/sample! (get-in cursors [id path])
(channel-frame choices anchors nodes
source-fps picture-fps id c lf)))
placed (volatile! #{})
ctx {:read (fn [id path _c lf] (ch/sample! (get-in cursors [id path]) lf))
:palette palette
:mat-for (fn [id] (get mats id))
:on-place (fn [id p] (vswap! placed assoc id p))
:mat-for (fn [id] (vswap! placed conj id) (get mats id))
:pinv-for (fn [id] (get pinvs id))
:buf-for (fn [id _n] (get bufs id))
:scratch scratch}
step (fn [f]
(vreset! placed {})
(vreset! placed #{})
(eval-into ctx nodes ord rank f))]
(reify
IFn
(-invoke [_ f] (step f))
IResolver
(world-of [_ id] (:m (get @placed id)))
(frame-of [_ id] (:f (get @placed id)))))))
(world-of [_ id] (when (contains? @placed id) (get mats id)))))))
;; ---------------------------------------------------------------------------
@ -549,19 +515,6 @@
(into (for [[id n] nodes
p (node/problems n)]
(str "node " (pr-str id) ": " p)))
;; Anchors re-address the node's measurement, regardless of its name.
(into (for [[id n] nodes
:let [anchors (:anchors n)]
:when (some? anchors)
:when (not (and (map? anchors) (contains? anchors 0)
(integer? (:frames tl))
(every? #(and (integer? %) (<= 0 %)
(< % (:frames tl)))
(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))))

4
frontend/src/arthur/domain/wire.cljs
View file

@ -15,8 +15,8 @@
a codec that returned a sorted map would work locally and stop working after one
round trip, which is the failure the plain-map rule already prevents.
The bytes are separate from transit: JSON block reads carry base64, while
uploads send binary file parts. `channel/dense-at` reads a block as
The bytes are separate and base64, because tier 2 is typed arrays and transit
has nothing to say about them. `channel/dense-at` reads a block as
`{:data <typed array> :state <Uint8Array>}` and both sides of the wire must hold
byte-for-byte the same array — a handle that names a sha256 has to name the
bytes you actually hold."

149
frontend/src/arthur/domain/zip.cljs
View file

@ -1,149 +0,0 @@
(ns arthur.domain.zip
"A ZIP with STORED entries, for shipping a frame sequence and its audio as one
file.
STORED — compression method 0, the bytes verbatim — because every entry going
into it is already deflated (a PNG's IDAT) or is PCM that the user is about to
hand a codec (the WAV). Deflating a deflated stream buys nothing and costs a
pass over every byte of a long export, and it is also what lets this namespace
be about the container alone: an archive with no compressor in it is a handful
of little-endian headers, and there is no dependency to vendor.
WHY A ZIP AND NOT A DIRECTORY. `showDirectoryPicker` would write the numbered
sequence straight to disk, which is closer to what an NLE wants, and it does not
exist in Firefox — which is a browser this tool is already known to behave
differently in (see `flow/ingest` on seeking). One archive downloads the same
way everywhere and pairs the picture with the sound it has to stay in sync with,
so the two cannot be separated on the way to the cutting room.
NO ZIP64. The offsets and sizes here are 32-bit, so this refuses an archive at
4GB rather than writing one whose central directory silently wraps. A 900-frame
export at 1920x1200 is tens of megabytes, so the limit is not in the way; a
limit that corrupts instead of refusing would be."
(:require [arthur.domain.crc32 :as crc32]))
(def ^:private limit
"The largest archive this writer will produce. Past it the format needs Zip64
and every offset below would have to be 64-bit."
0xffffffff)
(defn- bytes-of [^String s]
;; ASCII by construction — `0001.png`, `audio.wav` — and asserted rather than
;; assumed, because a non-ASCII name would need the UTF-8 general-purpose flag
;; and would otherwise arrive mojibake'd in the archive.
(let [out (js/Uint8Array. (.-length s))]
(dotimes [i (.-length s)]
(let [c (.charCodeAt s i)]
(when (> c 127)
(throw (ex-info "a zip entry name must be ASCII" {:name s})))
(aset out i c)))
out))
(defn- u16! [^js b at n]
(aset b at (bit-and n 0xff))
(aset b (+ at 1) (bit-and (unsigned-bit-shift-right n 8) 0xff)))
(defn- u32! [^js b at n]
(u16! b at (bit-and n 0xffff))
(u16! b (+ at 2) (unsigned-bit-shift-right n 16)))
(defn dos-time
"A `js/Date` as the two 16-bit fields ZIP inherited from MS-DOS: [date time].
Seconds have one bit less than they need, so they land on even values, and the
year is an offset from 1980. Both are the format's, not an approximation — a
date before 1980 is not representable and is clamped rather than wrapped into a
plausible-looking wrong one."
[^js d]
[(bit-or (bit-shift-left (max 0 (- (.getFullYear d) 1980)) 9)
(bit-shift-left (inc (.getMonth d)) 5)
(.getDate d))
(bit-or (bit-shift-left (.getHours d) 11)
(bit-shift-left (.getMinutes d) 5)
(quot (.getSeconds d) 2))])
(defn archive
"Entries -> the parts of one ZIP, ready for a `js/Blob`.
Each entry is `{:name \"0001.png\" :data <Uint8Array>}`. Returns a vector of
byte arrays rather than one buffer: the payloads are already in memory and a
long export is tens of megabytes, so the archive REFERS to them instead of
copying every one into a second buffer of the same size. `js/Blob` takes the
parts as they are.
`at` is the modification time stamped on every entry. Passed in rather than read
from the clock so that the same frames produce the same archive, byte for byte,
which is what makes it assertable."
([entries] (archive entries (js/Date.)))
([entries ^js at]
(let [[date time] (dos-time at)
;; One pass, because a central directory entry needs the local header's
;; OFFSET and therefore the running total, and the CRC is wanted in both
;; places. Building the two lists separately would mean either computing
;; every CRC twice or keeping a parallel vector of them.
{:keys [parts central offset]}
(reduce
(fn [{:keys [parts central offset]} {:keys [name data]}]
(let [nm (bytes-of name)
n (.-length nm)
size (.-length ^js data)
crc (crc32/of data)
local (js/Uint8Array. (+ 30 n))
dir (js/Uint8Array. (+ 46 n))]
(u32! local 0 0x04034b50) ; local file header
(u16! local 4 10) ; version needed: 1.0 is enough to store
(u16! local 6 0) ; no flags; the name is ASCII
(u16! local 8 0) ; method 0: stored
(u16! local 10 time)
(u16! local 12 date)
(u32! local 14 crc)
(u32! local 18 size) ; compressed size — the same, stored
(u32! local 22 size)
(u16! local 26 n)
(u16! local 28 0) ; no extra field
(.set local nm 30)
(u32! dir 0 0x02014b50) ; central directory header
(u16! dir 4 10) ; made by
(u16! dir 6 10) ; version needed
(u16! dir 8 0)
(u16! dir 10 0)
(u16! dir 12 time)
(u16! dir 14 date)
(u32! dir 16 crc)
(u32! dir 20 size)
(u32! dir 24 size)
(u16! dir 28 n)
(u16! dir 30 0) ; extra
(u16! dir 32 0) ; comment
(u16! dir 34 0) ; disk number
(u16! dir 36 0) ; internal attributes
(u32! dir 38 0) ; external attributes
(u32! dir 42 offset)
(.set dir nm 46)
(when (> (+ offset (.-length local) size) limit)
(throw (ex-info "this export is too big for a zip without Zip64"
{:bytes (+ offset (.-length local) size)})))
{:parts (conj parts local data)
:central (conj central dir)
:offset (+ offset (.-length local) size)}))
{:parts [] :central [] :offset 0}
entries)
dir-size (transduce (map #(.-length ^js %)) + 0 central)
end (js/Uint8Array. 22)]
(u32! end 0 0x06054b50) ; end of central directory
(u16! end 4 0) ; this disk
(u16! end 6 0) ; the disk the directory starts on
(u16! end 8 (count central))
(u16! end 10 (count central))
(u32! end 12 dir-size)
(u32! end 16 offset)
(u16! end 20 0) ; no archive comment
(-> (into parts central) (conj end) vec))))
(defn blob
"The archive as one `js/Blob`, which is what a download wants."
([entries] (blob entries (js/Date.)))
([entries at]
(js/Blob. (into-array (archive entries at)) #js {:type "application/zip"})))

216
frontend/src/arthur/events/export.cljs
View file

@ -1,216 +0,0 @@
(ns arthur.events.export
"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
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.
WHAT GOES IN THE DB IS THE REQUEST AND THE PROGRESS, never the frames. A
megabyte of PNG in app-db would be compared by every mounted subscription on
every tick."
(:require [arthur.domain.palette :as pal]
[arthur.export :as export]
[arthur.export.frames :as frames]
[arthur.footage.store :as store]
[clojure.string :as str]
[re-frame.core :as rf]))
(def zooms
"The integer zooms offered. 320x200 times these is 320x200 up to 1920x1200.
INTEGERS ONLY, and the list is short for that reason rather than for tidiness:
a stage at a non-integer scale has to invent pixels, and there is nothing in
this tool downstream of `domain/raster` that is allowed to. 6 is here because
1920 wide is what a delivery timeline usually is; the 1200 height that comes
with it is 16:10 and is the project's aspect, not a mistake to letterbox away."
[1 2 3 4 6])
(defn- stem
"A filesystem-safe name for the artefact: the clip's label and the target's.
The target is in the name because the clip, each symbol in its library and each
placement on its stage are all exportable, and they would otherwise land in the
downloads folder as the same file. It is the target's LABEL rather than its id
because a placement's id is a uuid, and `arthur-8f594d72-a97f-....zip` names
nothing to the person who has to find it again."
[label target]
(-> (str (or label "arthur") "-" (or target "main"))
(str/replace #"[^A-Za-z0-9._-]+" "-")
(str/replace #"^-+|-+$" "")
(str/lower-case)))
(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.
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
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))))
(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
the node map is keyed by."
[v]
(let [[kind tl node] (str/split v #":")]
(cond-> {:timeline (keyword tl)}
(= "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.
Placements 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)
(mapv (fn [[id n]]
{:timeline :main :isolate id
:label (or (:name n) (str id))})
placements))))
(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)})))
(rf/reg-sub ::state (fn [db _] (:export db)))
(rf/reg-sub
::targets
(fn [db _]
(targets (:clip (store/entry (:clip/current db))))))
(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
: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
;; 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})))
(rf/reg-event-db
::set-zoom
(fn [db [_ z]] (assoc-in db [:export :zoom] z)))
(rf/reg-event-fx
::start
(fn [{:keys [db]} _]
(if (get-in db [:export :busy?])
{}
(let [id (:clip/current db)
entry (store/entry id)
{:keys [timeline zoom isolate]} (:export db)]
{:db (update db :export merge {:busy? true :done 0
:total (:frames (export/plan
{:clip (:clip entry)
:timeline timeline
:isolate isolate
:zoom zoom}))
:status "rendering…"})
::run! {:clip (:clip entry)
:timeline timeline
:isolate isolate
:store (:store entry)
;; The same palette and ramp the preview resolves and blits
;; through. Read here rather than in the fx so that the effect
;; takes data and nothing else.
:palette (get {:arthur/default pal/index-of}
(:palette db) pal/index-of)
:ramp (get {:arthur/default pal/rgb} (:palette db) pal/rgb)
:zoom zoom
:picture-fps (get-in db [:clip :display-fps])
:audio-url (:audio entry)
:name (stem (:label entry)
(label-of (:clip entry)
{:timeline timeline :isolate isolate}))}}))))
(rf/reg-event-db
::progress
(fn [db [_ done total]]
(update db :export merge {:done done :total total})))
(rf/reg-event-db
::done
(fn [db [_ filename bytes]]
(update db :export merge
{:busy? false
:status (str "wrote " filename " · "
(.toFixed (/ bytes 1048576) 1) " MB")})))
(rf/reg-event-db
::failed
(fn [db [_ message]]
(update db :export merge {:busy? false :status (str "export failed: " message)})))
(defn- download!
"Hand the browser a blob as a file.
The object URL is revoked on a timeout rather than immediately: the click starts
the download asynchronously and revoking in the same turn cancels it in some
browsers, which presents as the button doing nothing at all."
[filename ^js blob]
(let [url (js/URL.createObjectURL blob)
a (.createElement js/document "a")]
(set! (.-href a) url)
(set! (.-download a) filename)
(.appendChild (.-body js/document) a)
(.click a)
(.removeChild (.-body js/document) a)
(js/setTimeout #(js/URL.revokeObjectURL url) 30000)))
(rf/reg-fx
::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
;; 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 /\"
;; forever. That reads as the tab having locked up, which is the worst way for
;; an export to fail — there is nothing to see and nothing in the status line.
;; Turning the throw into a rejection gives every failure one path to the user.
(-> (try (export/run! spec
(frames/exporter)
(fn [done total] (rf/dispatch [::progress done total])))
(catch :default e (js/Promise.reject e)))
(.then (fn [{:keys [filename ^js blob]}]
(download! filename blob)
(rf/dispatch [::done filename (.-size blob)])))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))

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

@ -16,35 +16,15 @@
[arthur.fx.http :as http]
[re-frame.core :as rf]))
(defonce ^:private clock (atom 0))
(defn- mark!
"Where the time goes, on the console, one line per stage.
Kept rather than removed after it earned its keep. Progress only paints every
fourth frame, so a stall near the end looks identical whether the decoder has
stopped delivering or the work after it is holding the main thread — and those
two were confused for each other three times before this printed the answer:
decoding was finished, and `measure-crops` was ten seconds of synchronous
arithmetic with nothing able to repaint."
[label]
(let [now (js/Date.now)
since (- now @clock)]
(reset! clock now)
(js/console.log (str "arthur ⏱ " label " +" since "ms"))))
(defn- detect-frames!
"Decode the proxy once, in order, and measure every frame as it goes.
"Walk the proxy once, forward, and measure every frame as it goes.
ONCE AND FORWARD IS A REQUIREMENT, NOT A STYLE. MediaPipe's video mode is a
tracker whose input stream refuses a timestamp that does not advance, and the
error it raises is terminal for the landmarker — so there is no re-reading a
frame and no second pass. That used to be a constraint the frame walk had to be
careful about; with a decoder it is simply what decoding is.
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."
frame, no retry of frame 40, and no second pass. Each frame is decoded, handed
to the detector at its own time in the take, and its mouth crop read off the
same canvas before the loop moves on."
[manifest model]
(let [[w h] [(:width manifest) (:height manifest)]
canvas (.createElement js/document "canvas")
@ -52,101 +32,56 @@
fps (:fps manifest)
raw (atom [])
crops (atom [])
inner (atom [])
total (:frames manifest)]
(set! (.-width canvas) w)
(set! (.-height canvas) h)
(rf/dispatch [::progress "loading the video…"])
(-> (ingest/stream! (ingest/stream-url manifest) total)
(-> (ingest/video! (ingest/video-url manifest) fps w h)
(.then
(fn [stream]
(ingest/decode!
stream 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 (or (zero? i) (zero? (mod (inc i) 4)) (= (inc i) total))
(rf/dispatch [::progress (str "detecting " (inc i) "/" total)]))
;; 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)))))))
(.then (fn [_]
(mark! (str "DECODE FINISHED — " (count @raw) " frames"))
(let [slots (detect/tracks @raw)
subjects (into {}
(map (fn [[id track]]
[id (assoc (detect/fill-gaps
(detect/pick @raw track))
:crops (detect/pick @crops track)
:interior (detect/pick @inner track)
:interior-settings take/knobs)]))
slots)]
(mark! "fill-gaps")
{:subjects subjects
:dimensions [w h]
;; Frames where NOBODY was found, which is a fact about the
;; footage. A frame one of two faces is missing from is a gap
;; in that subject's own detection mask and is reported there.
:missing (count (remove seq @raw))
:first-real (first (keep-indexed (fn [i faces] (when (seq faces) i))
@raw))}))))))
(defn presence-for
"Select a subject's masks and express them in its local feature names.
Unqualified manifest ids refer to the first face, as in single-face footage."
[manifest subject]
(not-empty
(into {} (keep (fn [[id mask]]
(when (= (or (namespace id) "face-1") (subs (str subject) 1))
[(keyword (name id)) mask])))
(:presence manifest))))
(fn [video]
(js/Promise.
(fn [resolve reject]
(letfn [(next-frame [i]
(if (= i total)
(try
(resolve (assoc (detect/fill-gaps @raw)
:dimensions [w h] :crops @crops))
(catch :default error (reject error)))
(-> (ingest/frame! video fps i)
(.then
(fn [_]
(.drawImage ctx (:el video) 0 0)
(let [face (detect/detect! model canvas
(ingest/frame-ms fps i))
ring (when face (mapv #(nth face %) lm/LIPS-INNER))
box (when ring (interior/crop ring [w h]))
pixels (when box
(.-data (.getImageData ctx (:x box) (:y box)
(:w box) (:h box))))]
(swap! raw conj face)
(swap! crops conj (when box {:box box :data pixels})))
(when (or (zero? i) (zero? (mod (inc i) 4)) (= (inc i) total))
(rf/dispatch [::progress (str "detecting " (inc i) "/" total)]))
;; Let the status paint between synchronous
;; MediaPipe calls.
(js/setTimeout #(next-frame (inc i)) 0)))
(.catch reject))))]
(next-frame 0)))))))))
(defn- build-clip [manifest detector
{:keys [subjects dimensions missing first-real] :as source-inputs}]
{:keys [dense detected dimensions crops missing first-real] :as source-inputs}]
(let [[w h] dimensions
_ (mark! "build-clip: start")
with-presence (into {}
(map (fn [[id inputs]]
[id (assoc inputs :presence (presence-for manifest id))]))
subjects)
frozen (take/footage manifest {:dimensions dimensions
:subjects with-presence
:detector detector})
_ (mark! "build-clip: freeze")
interior (source/measure-crops take/knobs crops)
frozen (take/footage manifest {:dense dense :detected detected
:dimensions dimensions :interior interior
:presence (:presence manifest)
:detector detector})
built (:clip frozen)
source-blocks (source/pack-subjects (:id (:analysis built)) subjects)
_ (mark! "build-clip: pack source blocks")]
source-blocks (source/pack (:id (:analysis built)) source-inputs)]
(assoc (select-keys built [:fps :width :height])
:frames (clip/frames built)
:display-fps (:fps built)
:clip built :store (:store frozen)
:source-blocks source-blocks
:source-inputs (assoc source-inputs :subjects with-presence)
:source-blocks source-blocks :source-inputs source-inputs
;; No cache-buster. The audio is a blob named by the hash of its own
;; bytes, so re-extracting gives it a different URL rather than
;; overwriting this one — which is what the `?v=` here used to work
@ -157,131 +92,44 @@
:cid (or (:id manifest) "footage")
:summary (str (:frames manifest) " frames · " w "×" h " · "
(:fps manifest) " fps"
(when (> (count subjects) 1)
(str " · " (count subjects) " faces"))
(when (pos? missing)
(str " · " missing " without a face"
(when (pos? first-real)
(str " (first found on " (inc first-real) ")"))))))))
(defn- with-default-interior!
"Backfill one subject's retained interior measurements at the default knobs."
[analysis subject track]
(let [frames (count (:crops track))
key (source/interior-key analysis subject take/knobs frames)]
(-> (http/GET (str "/api/blocks/" key))
(.then (fn [block]
(assoc track :interior (source/unpack-interior block take/knobs frames)
:interior-settings take/knobs
:interior-key key)))
(.catch (fn [error]
(if (= 404 (:status (ex-data error))) track (throw error)))))))
(defn saved-source!
"Restore retained source tracks by analysis id, for regeneration after open.
An analysis holds one set of blocks per tracked subject, so the count is a
multiple of `source/roles` rather than equal to it; `source/unpack` reads each
block's own descriptor to find out whose it is."
[key dimensions]
(-> (http/GET (str "/api/analyses/" key))
(.then (fn [^js analysis]
(let [keys (array-seq (.-source_blocks analysis))]
(when (and (seq keys) (zero? (mod (count keys) (count source/roles))))
(-> (js/Promise.all
(into-array (map #(http/GET (str "/api/blocks/" %)) keys)))
(.then (fn [blocks] (source/unpack blocks dimensions)))
(.then (fn [{:keys [subjects]}]
(-> (js/Promise.all
(into-array
(map (fn [[id track]]
(.then (with-default-interior! key id track)
(fn [filled] [id filled])))
subjects)))
(.then (fn [pairs]
{:subjects (into {} (array-seq pairs))
:dimensions dimensions}))))))))))
(.catch (fn [error]
(if (= 404 (:status (ex-data error))) nil (throw error))))))
(defn- cached-source! [manifest detector]
(saved-source! (:id (take/analysis-for manifest detector))
[(:width manifest) (:height manifest)]))
(defn measure-one!
"One subject's crops, ONE PER EVENT-LOOP TURN."
[settings track on-step]
(if (or (:interior track) (not (:crops track)))
(js/Promise.resolve track)
(let [crops (:crops track)
total (count crops)
interior (atom [])]
(js/Promise.
(fn [resolve reject]
(letfn [(step [i]
(if (= i total)
(resolve (assoc track :interior @interior
:interior-settings settings))
(try
(swap! interior conj (source/measure-crop settings (nth crops i)))
(when on-step (on-step (inc i) total))
(js/setTimeout #(step (inc i)) 0)
(catch :default error (reject error)))))]
(step 0)))))))
(defn measure-crops!
"Measure every retained crop's interior, one subject after another and one
crop per event-loop turn.
Done in a tight loop instead, 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.
Two callers, and the only difference between them is who is waiting: opening an
older analysis that predates the interior block backfills it behind a progress
line, and a knob drag that needs the pixels measured at new settings does the
same work with nobody watching, so it passes no `on-step`. The settings ride
back on each track, because a measurement and the knobs it was taken at are one
fact — `source/pack` will not address an interior block without them."
[settings track on-step]
(reduce (fn [chain [id one]]
(.then chain
(fn [acc]
(.then (measure-one! settings one on-step)
(fn [measured] (assoc-in acc [:subjects id] measured))))))
(js/Promise.resolve track)
(:subjects track)))
(let [key (:id (take/analysis-for manifest detector))]
(-> (http/GET (str "/api/analyses/" key))
(.then (fn [^js analysis]
(let [keys (array-seq (.-source_blocks analysis))]
(when (= (count keys) (count source/roles))
(-> (js/Promise.all
(into-array (map #(http/GET (str "/api/blocks/" %)) keys)))
(.then (fn [blocks]
(source/unpack blocks
[(:width manifest) (:height manifest)]))))))))
(.catch (fn [error]
(if (= 404 (:status (ex-data error))) nil (throw error)))))))
(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)))))
(build-clip manifest detector track))
(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]
(mark! "build-clip: done")
(let [id (store/install! entry)]
(rf/dispatch [::loaded id (:summary entry)]))))
(.catch (fn [error]

33
frontend/src/arthur/events/paint.cljs
View file

@ -1,33 +0,0 @@
(ns arthur.events.paint
(:require [arthur.domain.paint :as paint]
[arthur.footage.store :as store]
[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))))
(rf/reg-event-db
::add-key
(fn [db [_ id]]
(edit db #(paint/add-key % id (get-in db [:playback :frame])))))
(rf/reg-event-db
::set-vertex
(fn [db [_ id key-frame vertex point]]
(edit db #(paint/set-vertex % 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))))

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

@ -22,21 +22,13 @@
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]
[arthur.audio.mix :as mix]
[arthur.demo.stage :as stage]
[arthur.domain.feature :as feature]
[arthur.domain.project :as project]
[arthur.domain.wire :as wire]
[arthur.events.footage :as footage]
[arthur.events.playback :as pb]
[arthur.footage.store :as store]
[arthur.flow.address :as address]
[arthur.flow.ingest :as ingest]
[arthur.flow.regenerate :as regenerate]
[arthur.flow.source :as source]
[arthur.flow.take :as take]
[arthur.flow.ingest :as ingest]
[arthur.fx.http :as http]
[arthur.synth :as synth]
[re-frame.core :as rf]))
(defn- analysis-payload [analysis]
@ -47,20 +39,6 @@
(defn- block-keys [^js doc]
(into-array (map #(.-key %) (array-seq (.-blocks doc)))))
(defn- block-bytes [value]
(if (string? value)
(wire/bytes-of value)
(js/Uint8Array. (.-buffer value) (.-byteOffset value) (.-byteLength value))))
(defn- block-form [^js block]
(let [form (js/FormData.)]
(.append form "key" (.-key block))
(.append form "descriptor" (.-descriptor block))
(.append form "data" (js/Blob. #js [(block-bytes (.-data block))]) "block.bin")
(when-let [state (.-state block)]
(.append form "state" (js/Blob. #js [(block-bytes state)]) "state.bin"))
form))
(defn- upload-missing!
"POST the blocks the server said it does not have, and nothing else.
@ -68,9 +46,9 @@
this and it made sqlite answer \"database is locked\" on a save — which reaches
the page as a 500 with nothing wrong with the request. The backend was fixed too
(WAL, and a busy timeout, in server/settings.py), and this stays sequential
anyway: most uploads are small, and a burst of parallel writes to buy nothing
is how the same bug comes back the first time a take has sixty blocks instead
of eleven."
anyway: the uploads are a few kilobytes each, nothing is waiting on them, and a
burst of parallel writes to buy nothing is how the same bug comes back the first
time a take has sixty blocks instead of eleven."
[^js doc]
(-> (http/POST "/api/blocks/missing" #js {:keys (block-keys doc)})
(.then (fn [^js answer]
@ -78,9 +56,7 @@
todo (filterv #(contains? missing (.-key ^js %))
(array-seq (.-blocks doc)))]
(-> (reduce (fn [chain block]
(.then chain
(fn [_]
(http/POST-form "/api/blocks" (block-form block)))))
(.then chain (fn [_] (http/POST "/api/blocks" block))))
(js/Promise.resolve nil)
todo)
(.then (fn [_] (count todo)))))))))
@ -92,30 +68,42 @@
(.then (fn [^js created] (.-id created))))))
(defn- opened-entry! [^js clip-json]
(let [footage-id (.-footage clip-json)]
(let [footage-id (.-footage clip-json)
analysis-key (.-analysis clip-json)]
(-> (js/Promise.all
#js [(js/Promise.all
(into-array (map #(http/GET (str "/api/blocks/" %))
(array-seq (.-blocks clip-json)))))
(if footage-id
(http/GET (str "/api/footage/" footage-id))
(js/Promise.resolve nil))])
(.then (fn [[blocks ^js footage]]
(let [cid (.-cid clip-json)
loaded (project/load
cid #js {:leaves (.-leaves clip-json)
:blocks blocks})
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)
: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))
(.then (fn [audio] (assoc entry :audio audio)))))))))))
(if footage-id (ingest/manifest! footage-id) (js/Promise.resolve nil))
(if analysis-key (http/GET (str "/api/analyses/" analysis-key))
(js/Promise.resolve nil))])
(.then (fn [[blocks manifest analysis]]
(let [source-keys (when analysis (array-seq (.-source_blocks ^js analysis)))]
(-> (js/Promise.all
(into-array (map #(http/GET (str "/api/blocks/" %)) source-keys)))
(.then (fn [source-responses]
(let [cid (.-cid clip-json)
loaded (project/load
cid #js {:leaves (.-leaves clip-json)
:blocks blocks})
built (:clip loaded)
inputs (when (seq source-keys)
(when-not manifest
(throw (ex-info "saved analysis has no footage"
{:analysis analysis-key})))
(source/unpack source-responses
[(:width manifest) (:height manifest)]))]
(merge (select-keys built [:fps :width :height])
{:label (str (or (.-name clip-json) cid) " (saved)")
:cid cid :frames (clip/frames built)
:display-fps (:fps built)
:clip built :store (:store loaded)
:footage-id footage-id
:source-inputs inputs
:source-blocks (when inputs
(source/pack analysis-key inputs))
:audio (if manifest (:audio manifest)
"/static/arthur/audio.wav")})))))))))))
(rf/reg-fx
::save!
@ -131,16 +119,12 @@
(.then (fn [_]
(when (seq source-blocks)
(-> (upload-missing!
#js {:blocks (source/upload-blocks source-blocks)})
#js {:blocks (source/wire-blocks source-blocks)})
(.then (fn [_]
(http/PUT
(str "/api/analyses/" (:id analysis))
;; One set per tracked subject, in
;; the order `source/unpack` does
;; not depend on.
#js {:source_blocks
(into-array
(source/block-keys source-blocks))})))))))
(into-array (map :key (vals source-blocks)))})))))))
(.then (fn [_] (upload-missing! doc)))
(.then (fn [uploaded]
(-> (http/PUT (str "/api/projects/" pid)
@ -187,161 +171,6 @@
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(rf/reg-fx
::stage!
(fn [_]
(-> (http/GET (str "/api/projects/" (:source-project stage/layout)))
(.then (fn [^js saved]
(or (first (filter #(= (:source-cid stage/layout) (.-cid ^js %))
(array-seq (.-clips saved))))
(throw (ex-info "the saved 8625 clip is missing" {})))))
(.then opened-entry!)
(.then (fn [entry]
(let [built (stage/compose (:clip entry))
entry (assoc entry :clip built :label (:name built)
:cid "stage-8625" :frames (clip/frames built)
:width (:width built) :height (:height built))]
(-> (mix/mix! built (:audio entry) (:store entry))
(.then (fn [audio]
(rf/dispatch
[::stage-opened
(store/install! (assoc entry :audio audio) "stage")])))))))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(defonce ^:private retained-source (atom nil))
(defonce ^:private retained-interior (atom nil))
(defn- retained-interior! [analysis subject settings inputs]
(let [frames (count (:crops inputs))
block-key (source/interior-key analysis subject settings frames)]
(-> (http/GET (str "/api/blocks/" block-key))
(.then (fn [block]
(assoc inputs
:interior (source/unpack-interior block settings frames)
:interior-key block-key)))
(.catch (fn [error]
(if (= 404 (:status (ex-data error)))
(-> (footage/measure-one! settings (dissoc inputs :interior) nil)
(.then (fn [measured]
(let [{:keys [key descriptor data]}
(source/interior-block analysis subject settings
(:interior measured))]
(-> (upload-missing!
#js {:blocks #js [#js {:key key
:descriptor descriptor
:data data}]})
(.then (fn [_]
(assoc measured :interior-key block-key))))))))
(throw error)))))))
(defn- source-for! [entry]
(if-let [inputs (:source-inputs entry)]
(js/Promise.resolve inputs)
(let [analysis (get-in entry [:clip :analysis])]
(if (= (:id analysis) (:id @retained-source))
(:promise @retained-source)
(let [promise
(if (= "synth" (:detector analysis))
;; The synthetic take tracks one face and regenerating it reads
;; that face's landmarks, so it arrives in the same shape real
;; footage does rather than in a flat one only this branch uses.
(js/Promise.resolve
{:subjects
{:face-1 {:dense (synth/synth-dense (:frames analysis)
{:seed (:seed analysis)})}}})
(-> (ingest/manifest! (:footage-id entry))
(.then (fn [manifest]
(-> (footage/saved-source! (:id analysis)
[(:width manifest)
(:height manifest)])
(.then (fn [inputs]
(when-not inputs
(throw (ex-info "saved analysis has no source blocks" {})))
(update inputs :subjects
(fn [subjects]
(into {}
(map (fn [[id one]]
[id (assoc one :presence
(footage/presence-for
manifest id))]))
subjects))))))))))]
(do
(reset! retained-source {:id (:id analysis) :promise promise})
promise))))))
(defn- inputs-for-edit!
"Bring the EDITED SUBJECT's retained pixel measurements up to the settings this
edit needs. Only that subject's: a knob dragged on the second face does not
re-measure the first face's mouth."
[entry edit inputs]
(let [{clip :changed fids :features subject :subject} (regenerate/plan (:clip entry) edit)
teeth (first (filter #(= :teeth (get-in clip [:features % :area])) fids))
one (get-in inputs [:subjects subject])]
(if (and teeth (:crops one))
(let [settings (merge take/knobs (feature/effective-params clip teeth))
analysis (get-in clip [:analysis :id])
frames (count (:crops one))
key (source/interior-key analysis subject settings frames)
done (fn [measured] (assoc-in inputs [:subjects subject] measured))]
(if (and (:interior one)
(or (= (:interior-key one) key)
(and (nil? (:interior-key one))
(= key (source/interior-key analysis subject take/knobs frames)))))
(js/Promise.resolve inputs)
(.then (if (= key (:key @retained-interior))
(:promise @retained-interior)
(let [promise (retained-interior! analysis subject settings one)]
(reset! retained-interior {:key key :promise promise})
promise))
done)))
(js/Promise.resolve inputs))))
(rf/reg-fx
::preview-settings!
(fn [{:keys [id entry edit request]}]
(-> (source-for! entry)
(.then (fn [inputs] (inputs-for-edit! entry edit inputs)))
(.then (fn [inputs]
(regenerate/change (assoc entry :source-inputs inputs) edit)))
(.then (fn [changed]
(rf/dispatch [::settings-previewed id request changed])))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(rf/reg-event-fx
::preview-settings
(fn [{:keys [db]} [_ edit]]
(let [id (:clip/current db)
entry (store/entry id)]
(if (or (get-in db [:project :busy?]) (nil? (:analysis (:clip entry))))
{}
(let [plan (regenerate/plan (:clip entry) edit)
report (select-keys plan [:features :roles])
request (inc (or (:preview-request db) 0))]
(js/console.info "arthur regeneration" (clj->js (assoc report :edit edit)))
{:db (-> db
(assoc :preview-request request)
(update :project merge {:status "previewing…"})
(assoc :regeneration (assoc report :edit edit)))
::preview-settings! {:id id :entry entry :edit edit
:request request}})))))
(rf/reg-sub ::regeneration (fn [db _] (:regeneration db)))
(rf/reg-event-fx
::settings-previewed
(fn [{:keys [db]} [_ previous request entry]]
(if (and (= previous (:clip/current db))
(= request (:preview-request db)))
(let [id (store/install! entry "edited")]
{:db (-> db
(assoc :clip/current id)
(update :project merge {:status "preview · unsaved"}))})
{})))
;; ---------------------------------------------------------------------------
;; events
@ -367,28 +196,6 @@
::pb/pause! nil
::open! (:id (:project db))})))
(rf/reg-event-fx
::load-stage
(fn [{:keys [db]} _]
(if (:busy? (:project db))
{}
{:db (update db :project merge {:busy? true :status "loading 8625 stage…"})
::pb/pause! nil
::stage! nil})))
(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]})))
(rf/reg-event-db
::saved
(fn [db [_ id cid label seq written uploaded]]

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

@ -1,227 +0,0 @@
(ns arthur.export
"Export a TIMELINE: one frame walk, and a sink that decides what comes out.
THE SINK IS A PROTOCOL because there is more than one right answer to \"a
video file\" and they disagree about the thing this project cares most about.
A PNG sequence is bit-exact — the file holds the bytes `raster/draw-ops!`
produced, expanded through the ramp and nothing else. A muxed MP4 is one file
that plays anywhere, and every codec a browser can reach either subsamples
chroma (which puts fringes on precisely the hard flat-colour edges the whole
idiom is made of) or is a codec an NLE will not open. Those are different
trades for different jobs, not a better and a worse, so both should be
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
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
methods.
TWO RULES THE WALK ENFORCES, both about sync:
Every frame of the timeline'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
off the picture, which is the one artefact this tool exists to prevent.
The zoom is an INTEGER. A pixel becomes a block of identical pixels. Anything
else resamples, and `domain/png` and `ui/canvas` both have the longer argument
for why that is not allowed to happen here."
;; `run!` is the verb this namespace is about, and nothing here folds a
;; side-effect over a seq, so core's loses the name rather than ours.
(:refer-clojure :exclude [run!])
(:require [arthur.audio.mix :as mix]
[arthur.domain.clip :as clip]
[arthur.domain.raster :as raster]))
(defprotocol Exporter
"A sink for a rendered timeline. 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
`IResolver` would suggest, because it names a role a thing plays rather than a
capability a value has."
(begin! [this spec]
"Prepare to receive frames.
`spec` carries everything constant for the export:
:name a filesystem-safe stem for the artefact
:width stage width in raster pixels, before zoom
:height stage height, before zoom
:zoom integer pixel multiplier
: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
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
will accept a sample.")
(frame! [this i raster]
"Take frame `i`, an indexed `domain/raster`.
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
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.")
(finish! [this]
"Close the artefact. Promise of `{:filename :blob}`."))
(defn kin
"The ids to keep when isolating `id` in `nodes`.
Four things, and each for its own reason:
the node itself;
everything ABOVE it, because a placement's transform is relative to its
parent and dropping the chain would move the thing being isolated;
everything BELOW it, because a group instance is its children;
any audio track `:linked-to` it, because the link is the statement that this
sound belongs to that placement, and a face exported without its voice is
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."
[nodes id]
(let [up (loop [i id acc #{}]
(if (or (nil? i) (contains? acc i))
acc
(recur (:parent (get nodes i)) (conj acc i))))
down (loop [edge #{id} acc #{}]
(if (empty? edge)
acc
(let [acc' (into acc edge)]
(recur (set (for [[k n] nodes
:when (and (contains? edge (:parent n))
(not (contains? acc' k)))]
k))
acc'))))
kept (into up down)]
(into kept
(for [[k n] nodes
:when (and (= :audio (:kind n)) (contains? kept (:linked-to n)))]
k))))
(defn isolate
"The timeline 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
its own time, identically for all seven placements. Isolating one placement
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))
(defn- yield!
"Hand the event loop a turn between frames.
`setTimeout 0` and not a resolved promise: a promise continuation is a
microtask, so a chain of them runs to completion without the browser ever
painting, and the progress readout would jump from 0 to done. `flow/ingest`'s
decode loop pauses for the same reason."
[]
(js/Promise. (fn [resolve] (js/setTimeout resolve 0))))
(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)
(.then (fn [buffer]
(cond
buffer buffer
(and (= tid clip/root-id) fallback-url) (mix/decode! fallback-url)
:else nil)))))
(defn plan
"What an export of `tid` 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))
zoom (max 1 (js/Math.floor (or zoom 1)))]
(when tl
{:frames (:frames tl)
:fps (:fps clip)
:zoom zoom
:width (* (:width clip) zoom)
:height (* (:height clip) zoom)
:seconds (/ (:frames tl) (: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))})))
(defn run!
"Render `timeline` 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}
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
: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
{:picture-fps picture-fps})
ras (raster/make (:width clip) (:height clip))
bg (get palette :bg 0)]
(-> (audio! doc timeline store audio-url)
(.then (fn [audio]
(js/Promise.resolve
(begin! exporter {:name name :width (:width clip)
:height (:height clip) :zoom zoom
:fps fps :frames frames :ramp ramp
:audio audio}))))
(.then (fn [_]
;; A fold over the frames as a promise CHAIN rather than a
;; doseq: each frame has to wait for the last one's sink to
;; drain, and `reduce` building that chain is the shape that
;; says so. Nothing here is concurrent on purpose — an encoder
;; fed from two places at once is not fast, it is wrong.
(reduce
(fn [chain i]
(.then chain
(fn [_]
(-> ras
(raster/clear! bg)
(raster/draw-ops! (resolve-frame i)))
(-> (js/Promise.resolve (frame! exporter i ras))
(.then (fn [_]
(when on-progress
(on-progress (inc i) frames))
(yield!)))))))
(js/Promise.resolve)
(range frames))))
(.then (fn [_] (finish! exporter)))))))

77
frontend/src/arthur/export/frames.cljs
View file

@ -1,77 +0,0 @@
(ns arthur.export.frames
"An `Exporter` that writes a numbered PNG sequence and its WAV into one zip.
THE MASTER FORMAT. Every other export is a re-interpretation of this one: the
PNGs hold exactly the bytes `raster/draw-ops!` wrote, expanded through the ramp
at an integer zoom, so nothing between the scanline fill and the file resamples,
subsamples or smooths. `domain/png` has the argument for why that matters here
more than it would in most tools.
IT IS ALSO SMALLER THAN IT SOUNDS, which is worth saying because \"lossless
frame sequence\" reads as gigabytes. That intuition comes from photographic
frames — the 1440x1920 source stills this project stopped storing were 112MB for
7.6 seconds. This is nine palette colours of flat fill at 320x200, upscaled by
an integer: a frame's entropy is on the order of kilobytes, and the zoom is
nearly free because a duplicated scanline filters to zeros. The finished master
of a take runs comparable to the lossy PROXY of the footage it came from.
ONE ARCHIVE, PICTURE AND SOUND TOGETHER, rather than two downloads. They have
to stay in sync all the way to the cutting room, and a second `<a download>`
click is also the one a browser is most likely to block."
(:require [arthur.audio.mix :as mix]
[arthur.domain.png :as png]
[arthur.domain.zip :as zip]
[arthur.export :as export]))
(defn- pad
"Frame numbers are ONE-BASED and zero-padded to a fixed width, because that is
what an NLE's image-sequence importer looks for: a common stem, a fixed-width
counter, one extension. Width comes from the frame count, so a 900-frame export
is `0001`..`0900` and nothing sorts `10` before `9`."
[i width]
(let [s (str i)]
(str (.repeat "0" (max 0 (- width (.-length s)))) s)))
(defn exporter
"A frame-sequence `Exporter`.
`at` is the timestamp stamped on every zip entry, defaulting to now. It is a
parameter so that the same frames produce the same archive byte for byte, which
is what makes `export.frames-test` able to assert on one."
([] (exporter (js/Date.)))
([at]
(let [state (atom nil)]
(reify export/Exporter
(begin! [_ {:keys [name width height zoom fps frames ramp audio]}]
(reset! state
{:name name
:ramp ramp
:fps fps
:frames frames
;; Held once. At zoom 6 the scratch inside it is seven
;; megabytes, which is not a thing to allocate per frame.
:encode (png/encoder width height zoom)
:digits (max 4 (.-length (str frames)))
:entries (cond-> []
audio (conj {:name (str name "/audio.wav")
:data (mix/wav-bytes audio)}))})
nil)
(frame! [_ i raster]
(let [{:keys [encode ramp name digits]} @state]
;; Encoded HERE, inside the frame's turn, because the walk reuses the
;; raster: keeping a reference to it and encoding later would encode
;; the last frame N times, and every frame would be a valid PNG of the
;; wrong picture.
(-> (encode raster ramp)
(.then (fn [bytes]
(swap! state update :entries conj
{:name (str name "/" (pad (inc i) digits) ".png")
:data bytes})
nil)))))
(finish! [_]
(let [{:keys [name entries]} @state]
(js/Promise.resolve
{:filename (str name ".zip")
:blob (zip/blob entries at)})))))))

53
frontend/src/arthur/flow/address.cljs
View file

@ -68,7 +68,7 @@
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]}]
[{:keys [detector version source footage frames fps aspect seed mode]}]
(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})))
@ -81,8 +81,7 @@
source (assoc :source source)
footage (assoc :footage footage)
seed (assoc :seed seed)
mode (assoc :mode mode)
tracking (assoc :tracking tracking))))
mode (assoc :mode mode))))
(defn analysis
"An analysis record with its `:id` filled in. The record is tier 1 — it says
@ -95,9 +94,12 @@
;; the observation masks
(defn- feature-name
"An explicit subject or feature id as a descriptor string."
"A feature id as a descriptor string. `canon` refuses a keyword value on
purpose — so that \"mouth\" and :mouth cannot address the same block — and this
is the naming it insists happens at the call site. `nil` is the whole face,
which is what a track with no feature follows."
[id]
(subs (str id) 1))
(if id (subs (str id) 1) "face"))
(defn observation
"A digest of exactly the absence data one block reads.
@ -109,9 +111,10 @@
block reads `:eye-r` and `:eye-l`'s presence and no other feature's, so a gap in
one brow does not rewrite the mouth's address for nothing.
Head tracks name their subject and follow its detection mask."
`nil` features mean the track follows the whole face's detection rather than a
feature's presence, which is what the head's three blocks do."
[features {:keys [detected presence]}]
(let [wanted (sort-by str (distinct features))
(let [wanted (sort-by str (distinct (keep identity features)))
masks (into {} (map (fn [id] [id (mapv boolean (get presence id))]))
(filter #(contains? presence %) wanted))]
(when (or detected (seq masks))
@ -145,8 +148,6 @@
"source/dense" []
"source/detected" []
"source/crops" []
"source/interior" [:blob-grow :cavity-erode :min-area :teeth-verts
:tongue-reject :top-bias]
"head-pos" [:anchor-avg]
"head-rot" [:anchor-avg]
"head-scale" [:anchor-avg]
@ -184,40 +185,6 @@
[knob]
(get knob-roles knob #{}))
(def area-roles
"Feature area -> the block roles `freeze/part` freezes for it.
The other half of a question neither table answers alone. `block-knobs` says
which knobs reach a ROLE's bytes; this says which roles a FEATURE owns; and what
a regeneration actually asks is which knobs reach one feature."
{:mouth ["geom"]
:eye ["eyes" "iris-pos"]
:brow ["brows" "brow-pos"]
:teeth ["teeth"]})
(def framed-knobs
"Feature area -> the knobs its TIER 1 channels read.
What `block-knobs` cannot answer and deliberately does not: a framed radius and a
keyed `[:vis]` hold no bytes, so no block key moves when they move — and a
re-freeze still has to happen or the knob does nothing at all. This is the half
that used to live nowhere, and a regeneration had to guess at with a per-knob
special case. `regenerate-test` asserts the biconditional over the union, the
same way `address-test` does for `block-knobs`, so it is checked and not believed.
`:aperture-cut` is here AND in the teeth block: it gates `mouth-in`'s visibility
in tier 1 and the interior contour's smoothing in tier 2. One knob, two features,
two routes — which is exactly why this cannot be a per-area list of its own."
{:mouth #{:aperture-cut}
:eye #{:blink-cut :iris-size :pupil-size}
:brow #{}
:teeth #{}})
(defn area-knobs
"Every knob one feature area's frozen output depends on, across both tiers."
[area]
(into (get framed-knobs area #{}) (mapcat block-knobs) (get area-roles area)))
(defn block-descriptor
"The canonical text naming one dense block.

122
frontend/src/arthur/flow/detect.cljs
View file

@ -4,10 +4,6 @@
(defonce ^:private instance (atom nil))
(defonce ^:private pending (atom nil))
(def settings
"Detection and assignment inputs, also included in the analysis address."
{:max-faces 4 :assignment "nearest-centroid-v1" :gate 0.2})
(defn discard!
"Throw away the cached landmarker so the next run builds a fresh one.
@ -47,7 +43,7 @@
#js {:modelAssetPath "/static/mediapipe/face_landmarker.task"
:delegate "CPU"}
:runningMode "VIDEO"
:numFaces (:max-faces settings)})))
:numFaces 1})))
(.then (fn [model]
(reset! instance model)
model))
@ -59,8 +55,8 @@
(js/Promise.reject (js/Error. "local MediaPipe script did not load"))))))
(defn detect!
"Detect one already-drawn canvas frame at its own time in the take. An empty
vector means no face was detected.
"Detect one already-drawn canvas frame at its own time in the take. nil means no
face was detected.
`at-ms` IS THE FRAME'S REAL PRESENTATION TIME, and all three words are
load-bearing. In VIDEO mode the graph is a tracker: it runs face DETECTION only
@ -79,95 +75,14 @@
against 0.013), because a tracker told that every frame is 1ms apart expects a
face that has barely moved."
[model canvas at-ms]
(let [faces (aget (.call (aget model "detectForVideo") model canvas at-ms)
"faceLandmarks")]
(mapv (fn [face] (mapv (fn [p] {:x (.-x p) :y (.-y p) :z (.-z p)}) face))
(array-seq faces))))
;; ---------------------------------------------------------------------------
;; which face is which
;;
;; MediaPipe hands back a LIST, and a list has an order rather than an identity.
;; Nothing in the API promises that slot 0 is the same person on frame 41 as on
;; frame 40 — and when two faces cross, or one is briefly lost and re-detected,
;; it is not. Left unassigned, the two faces' geometry would swap mid-shot inside
;; one dense block, which reads as both heads snapping and is invisible in any
;; per-frame assertion.
;;
;; So identity is assigned HERE, once, by nearest centroid to each track's last
;; known position. Greedy and cheap: a handful of faces, one pass, and the
;; ordering it produces is the `:subjects` map every later stage keys on.
(defn- centroid [face]
(let [n (count face)]
{:x (/ (reduce + (map :x face)) n)
:y (/ (reduce + (map :y face)) n)}))
(defn- distance [a b]
(let [dx (- (:x a) (:x b)) dy (- (:y a) (:y b))]
(js/Math.sqrt (+ (* dx dx) (* dy dy)))))
(defn assign
"Per-frame lists of faces -> one vector per TRACK of `detection index or nil`.
INDICES AND NOT FACES, because a detection is more than its landmarks: the
mouth crop and the pixel measurement taken beside it on the same frame have to
follow the same face, and handing back the index is what lets one assignment
re-key all three. Whoever holds the per-frame lists does the lookup.
A track is claimed by the unclaimed detection nearest its last known centroid,
nearest pair first, so a frame where MediaPipe swaps its slot order does not
swap the tracks. A detection that matches no existing track within `gate`
starts a new one — which is how a second person walking into the shot on frame
200 gets their own subject instead of stealing the first one's.
`gate` is in normalised image units: two centroids closer than this on
consecutive frames are one face moving, and further apart are not."
([frames] (assign frames (:gate settings)))
([frames gate]
(let [step (fn [[rows last] faces]
(let [cs (mapv centroid faces)
pairs (sort-by :d
(for [[t at] (map-indexed vector last)
:when at
[d c] (map-indexed vector cs)
:let [gap (distance at c)]
:when (< gap gate)]
{:d gap :track t :face d}))
claim (reduce (fn [{:keys [by-track taken] :as acc}
{:keys [track face]}]
(if (or (contains? by-track track)
(contains? taken face))
acc
{:by-track (assoc by-track track face)
:taken (conj taken face)}))
{:by-track {} :taken #{}}
pairs)
opened (map-indexed (fn [i d] [(+ (count last) i) d])
(remove (:taken claim) (range (count faces))))
by-track (into (:by-track claim) opened)
width (+ (count last) (count opened))]
[(conj rows (mapv by-track (range width)))
(mapv (fn [t] (if-let [d (get by-track t)]
(nth cs d)
(nth last t nil)))
(range width))]))
[rows _] (reduce step [[] []] frames)
width (reduce max 0 (map count rows))]
;; Transposed to column-major: one vector per subject, padded to the final
;; width so a track that opened late still spans the whole take.
(mapv (fn [t] (mapv (fn [row] (nth row t nil)) rows))
(range width)))))
(when-let [face (aget (aget (.call (aget model "detectForVideo") model canvas at-ms)
"faceLandmarks") 0)]
(mapv (fn [p] {:x (.-x p) :y (.-y p) :z (.-z p)}) face)))
(defn fill-gaps
"Keep the detection mask while supplying real poses for measurement. A leading
gap uses the first observed face; later gaps hold the previous observed pose.
Freeze uses the mask to mark those frames absent in the channel blocks.
ONE TRACK, which is one subject: the mask says when THIS face was on screen,
and two faces in a shot have two of them. A frame where the second person has
not walked in yet is a frame their track is absent on, which is the same fact
as a frame nobody was found on and needs no second mechanism."
Freeze uses the mask to mark those frames absent in the channel blocks."
[raw]
(let [first-real (first (keep-indexed (fn [i frame] (when frame i)) raw))]
(when-not first-real
@ -180,26 +95,3 @@
:detected (mapv some? raw)
:missing (count (remove some? raw))
:first-real first-real}))
(defn subject-id
"Track index -> the subject that owns it. `:face-1` is the first face found,
which is also the id a single-face take has always used."
[i]
(keyword (str "face-" (inc i))))
(defn tracks
"Per-frame detection lists -> `{:face-1 <slots>, …}`, one entry per tracked
face, each a per-frame detection index or nil."
[frames]
(let [assigned (assign frames)]
(when (empty? assigned)
(throw (ex-info "no face found in any frame — check framing and light" {})))
(into {} (map-indexed (fn [i slots] [(subject-id i) slots])) assigned)))
(defn pick
"One track's slots applied to anything measured PER DETECTION — the landmarks,
the mouth crop, the pixel measurement taken beside it. All three were recorded
in detection order on a frame where nobody yet knew whose face was whose, and
this is the single lookup that turns any of them into one subject's track."
[per-frame slots]
(mapv (fn [row slot] (when slot (nth row slot))) per-frame slots))

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

@ -34,7 +34,6 @@
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]
[arthur.flow.address :as address]))
@ -83,7 +82,7 @@
ABSENCE IS PER TRACK, and `:features` is what says whose. Each track names the
feature it follows, so one occluded eye can be absent while its partner still
has a value; a subject id means the track follows whole-face detection and no
has a value; `nil` means the track follows the whole face's detection and no
feature, which is what the head's blocks do. `absent?` is then asked
`(absent? feature f)` and never about a track index.
@ -246,47 +245,65 @@
:tx (* (- s') (+ (* c tx) (* sn ty)))
:ty (* (- s') (+ (* (- sn) tx) (* c ty)))}))
(def ^:private head-modes #{:free :anchored})
(def ^:private head-modes #{:locked :as-filmed :per-plate})
(defn head-mode
"Keep a subject's measured transform dense; optionally hold chosen source
frames.
"Rewrite `:head`'s transform channels into one of the three shapes.
A nil anchor map reads measured frame f at frame f (free movement).
`{0 12}` locks to the measured transform of source frame 12. `{0 12, 40 42}`
cuts to source frame 42 at local frame 40. The same map selects position,
rotation and scale, so the head and registered photo cannot drift apart.
No analysis block or authored face placement changes.
STABILISATION IS A CHANNEL, NOT A MODE. `{s θ tx ty}` per frame IS
`[:xform :scale]`, `[:xform :rot]` and `[:xform :pos]`, so removing the head's
motion is not a pipeline setting — it is a question of which shape one node's
channels carry:
ONE SUBJECT AT A TIME when `:subject` is given, and EVERY subject when it is
not. Two faces in one shot were filmed together and are posed apart: choosing
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."
[{:keys [subject mode anchors]} {:keys [clip]}]
:locked framed identity — the head sits still, for tracing and for
judging articulation
:as-filmed dense — the head moves around the stage
:per-plate keyed at the kept frames — the head pose is stable for exactly as
long as a drawing is on screen, which is what a plate strip wants
ALWAYS MEASURE, ALWAYS STORE FACTORED, whatever the toggle says. The blocks are
written once and every mode reads them or ignores them; making this an
analysis-time switch would lose two things downstream. \"Smooth the transform,
never the contour\" only means anything while the two are separate. And a
velocity minimum is \"articulation paused\" in head-local space and \"the head
happened to be still\" in image space, so key selection needs the split to exist
in storage.
So this is a DOCUMENT EDIT: tier 1, undoable, syncable, instant, and not a
reason to re-analyse. It rewrites `:head` and touches nothing else — in
particular not `:face`, which a hand placed, and not one byte of any block.
`:per-plate` samples the dense track at the kept frames and stores plain
vectors. It may not store what `value-at` handed it: a wide dense read is a
VIEW into the block, and a view into tier 2 sitting in the document is a value
that changes when a re-freeze rewrites the array under it."
[{:keys [mode kept]} {:keys [clip store]}]
(when-not (contains? head-modes mode)
(throw (ex-info "head mode must be free or anchored"
(throw (ex-info "head mode is not one of the three channel shapes"
{:mode mode :modes head-modes})))
(when (and (= mode :free) (some? anchors))
(throw (ex-info "free head motion has no anchors" {:anchors anchors})))
(when (and subject (not (contains? (:subjects clip) subject)))
(throw (ex-info "head mode names a subject this clip did not track"
{:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))})))
(reduce
(fn [c sid]
(let [frames (get-in c [:timelines 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]
(fn [n]
(cond-> (assoc n :channels (:measured n))
(= mode :anchored) (assoc :anchors anchors)
(= mode :free) (dissoc :anchors))))))
clip (if subject [subject] (sort-by str (keys (:subjects clip))))))
(let [base (get-in (clip/root clip) [:nodes :head :measured])
at (fn [path f]
(let [v (ch/value-at (get base path) f store)
n (:stride (:dense (get base path)))]
(if (= 1 n) v (mapv #(ch/component v %) (range n)))))
keys-of (fn [path]
(-> (get base path)
(dissoc :dense)
(assoc :keys (into {} (map (juxt identity #(at path %))) (sort kept)))))]
(when (and (= mode :per-plate) (empty? kept))
(throw (ex-info "the per-plate head mode needs a kept-frame set; it is the plate strip's, not measurement's"
{:mode mode})))
(assoc-in clip [:timelines clip/root-id :nodes :head :channels]
(case mode
;; No `:generated` on the locked shape, and that is not an
;; oversight: nothing generated this identity. It is a decision,
;; and provenance that claimed otherwise would offer a re-freeze
;; button that could only undo it.
:locked {[:xform :pos] (ch/framed [0.0 0.0])
[:xform :rot] (ch/framed 0.0)
[:xform :scale] (ch/framed [1.0 1.0])}
:as-filmed base
:per-plate (into {} (map (juxt key #(keys-of (key %)))) base)))))
;; ---------------------------------------------------------------------------
;; the aperture, onto [:vis] of :mouth-in
@ -330,63 +347,34 @@
(range (count values))))
:generated generated))
(def ^:private pose-groups
{:mouth :mouth :mouth-in :mouth :teeth :mouth
:eye-r :eye-r :eye-r-in :eye-r :iris-r :eye-r :pupil-r :eye-r
:eye-l :eye-l :eye-l-in :eye-l :iris-l :eye-l :pupil-l :eye-l
:brow-r :brow-r :brow-l :brow-l})
(defn- performance-nodes
"Mark channels that read the containing instance's pose choices."
[nodes]
(into {}
(map (fn [[id n]]
[id (if-let [group (get pose-groups id)]
(-> n
(assoc :pose-group group)
(update :channels
(fn [channels]
(into {}
(map (fn [[path ch]]
[path (cond-> ch
(and (:generated ch) (:animated? ch))
(assoc :pose-sampled? true))]))
channels))))
n)]))
nodes))
;; ---------------------------------------------------------------------------
;; the face, onto the stage
(defn- motion-points
"Every source-space point one subject's drawn features visit over the shot,
including raised brows and a moving mouth."
[{:keys [rigid transforms outer eyes brows detected]}]
(mapcat (fn [i]
(when (or (nil? detected) (nth detected i))
(let [local (concat (nth outer i)
(when eyes (concat (nth (:lash-r eyes) i)
(nth (:lash-l eyes) i)))
(when brows (concat (nth (:ring-r brows) i)
(nth (:ring-l brows) i))))]
(concat (nth rigid i)
(geom/apply-sim-all (invert (nth transforms i))
local)))))
(range (count outer))))
(defn- fit-points
"Source-space points -> the placement that puts their bounding box on stage."
[[w h] points]
(let [xs (map :x points)
ys (map :y points)
x0 (reduce min xs)
x1 (reduce max xs)
y0 (reduce min ys)
y1 (reduce max ys)
cx (/ (+ x0 x1) 2)
cy (/ (+ y0 y1) 2)
k (min (/ (* 0.8 w) (max 1e-9 (- x1 x0)))
(/ (* 0.8 h) (max 1e-9 (- y1 y0))))]
(defn- motion-placement
"An editable default framing for a real take. Fit every drawn face feature's
observed motion inside the stage, including raised brows and a moving mouth."
[[w h] {:keys [rigid transforms outer eyes brows detected]}]
(let [points (mapcat (fn [i]
(when (or (nil? detected) (nth detected i))
(let [local (concat (nth outer i)
(when eyes (concat (nth (:lash-r eyes) i)
(nth (:lash-l eyes) i)))
(when brows (concat (nth (:ring-r brows) i)
(nth (:ring-l brows) i))))]
(concat (nth rigid i)
(geom/apply-sim-all (invert (nth transforms i))
local)))))
(range (count outer)))
xs (map :x points)
ys (map :y points)
x0 (reduce min xs)
x1 (reduce max xs)
y0 (reduce min ys)
y1 (reduce max ys)
cx (/ (+ x0 x1) 2)
cy (/ (+ y0 y1) 2)
k (min (/ (* 0.8 w) (max 1e-9 (- x1 x0)))
(/ (* 0.8 h) (max 1e-9 (- y1 y0))))]
{[:xform :anchor] (ch/framed [cx cy])
[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) cx) (- (/ h 2) cy)])}))
@ -424,63 +412,26 @@
POSITION puts the anchor a QUARTER of the way down the stage, because the rigid
landmarks are eyes and nose — the upper middle of a face — so a quarter down
leaves the jaw and the mouth on the stage. Whatever hangs off is clipped, which
is not a feature to add: every fill in `domain/raster` clamps already.
All subjects share one source-to-stage mapping on the :face group. Each
instance can then be placed independently with ordinary transform channels."
[{:keys [stage fit-motion?]} subjects]
(let [[w h] stage
inputs (vals subjects)]
(if fit-motion?
(fit-points stage (mapcat motion-points inputs))
(let [ref (mapcat :ref inputs)
c (geom/centroid ref)
span (- (reduce max (map :x ref)) (reduce min (map :x ref)))
k (/ (* 0.4 w) span)]
{[:xform :anchor] (ch/framed [(:x c) (:y c)])
[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) (:x c))
(- (* 0.25 h) (:y c))])}))))
(defn- mouth-part [subject absent? obs
{:keys [analysis verts anchor-avg contour-avg aperture-cut] :as params}
{:keys [outer inner] :as inputs}]
(let [own (partial feature/owned subject)
mouth (own :mouth)
rings (block {:role "geom" :analysis (:id analysis) :params params
:tracks ["outer" "inner"]}
{:type "int16" :scale geom-scale
:features [mouth mouth] :absent? absent?}
obs [(rings->flat outer verts) (rings->flat inner verts)])
prov (fn [by]
{:by by :analysis (:id analysis)
:params {:anchor-avg anchor-avg :contour-avg contour-avg
:verts verts}})]
{:nodes {:mouth
{:id :mouth :name "mouth" :kind :poly :parent :head :z "a1"
:channels {[:geom :pts] (dense rings 0 (prov :roto/lips-outer))
[:style :color] (ch/framed :skin-dark)}}
:mouth-in
{:id :mouth-in :name "mouth interior" :kind :poly
:parent :mouth :z "a2"
:channels {[:geom :pts] (dense rings 1 (prov :roto/lips-inner))
[:style :color] (ch/framed :mouth-dark)
[:vis] (visibility params inputs
{:by :roto/mouth-aperture
:analysis (:id analysis)
:params {:anchor-avg anchor-avg
:aperture-cut aperture-cut}})}}}
:store (stored rings)}))
is not a feature to add: every fill in `domain/raster` clamps already."
[{:keys [stage fit-motion?]} {:keys [ref] :as inputs}]
(if fit-motion?
(motion-placement stage inputs)
(let [[w h] stage
c (geom/centroid ref)
span (- (reduce max (map :x ref)) (reduce min (map :x ref)))
k (/ (* 0.4 w) span)]
{[:xform :anchor] (ch/framed [(:x c) (:y c)])
[:xform :scale] (ch/framed [k k])
[:xform :pos] (ch/framed [(- (/ w 2) (:x c))
(- (* 0.25 h) (:y c))])})))
(defn- feature-parts
"Freeze eyes and brows into their own dense blocks and scene nodes. This owns
only representation: the landmark correspondence, blink and pose choices have
already been settled by measure and condition."
[subject absent? obs
{:keys [eye-verts brow-verts analysis contour-avg anchor-avg] :as params}
[absent? obs {:keys [eye-verts brow-verts analysis contour-avg anchor-avg] :as params}
{:keys [eyes brows]}]
(let [own (partial feature/owned subject)
provenance (fn [by extra]
(let [provenance (fn [by extra]
{:by by :analysis (:id analysis)
:params (merge {:anchor-avg anchor-avg :contour-avg contour-avg}
extra)})
@ -494,26 +445,20 @@
;; feature each one follows, in the same order. The two vectors are read
;; together on purpose: this is the mapping `pack` cannot check for itself,
;; and `each-dense-track-follows-its-own-features-presence` is what pins it.
eye-block (when eyes (named "eyes"
eye-block (named "eyes"
["lash-r" "lid-r" "lash-l" "lid-l"]
[(own :eye-r) (own :eye-r) (own :eye-l) (own :eye-l)]
[:eye-r :eye-r :eye-l :eye-l]
"int16"
(mapv #(rings->flat % eye-verts)
[(:lash-r eyes) (:lid-r eyes)
(:lash-l eyes) (:lid-l eyes)])))
iris-block (when eyes
(named "iris-pos" ["iris-r" "iris-l"]
[(own :eye-r) (own :eye-l)] "float32"
[(:iris-r eyes) (:iris-l eyes)]))
brow-block (when brows
(named "brows" ["ring-r" "ring-l"]
[(own :brow-r) (own :brow-l)] "int16"
(:lash-l eyes) (:lid-l eyes)]))
iris-block (named "iris-pos" ["iris-r" "iris-l"] [:eye-r :eye-l] "float32"
[(:iris-r eyes) (:iris-l eyes)])
brow-block (named "brows" ["ring-r" "ring-l"] [:brow-r :brow-l] "int16"
(mapv #(rings->flat % brow-verts)
[(:ring-r brows) (:ring-l brows)])))
brow-pos-block (when brows
(named "brow-pos" ["pos-r" "pos-l"]
[(own :brow-r) (own :brow-l)] "float32"
[(:pos-r brows) (:pos-l brows)]))
[(:ring-r brows) (:ring-l brows)]))
brow-pos-block (named "brow-pos" ["pos-r" "pos-l"] [:brow-r :brow-l] "float32"
[(:pos-r brows) (:pos-l brows)])
eye-node (fn [id z track]
{:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
:channels {[:geom :pts] (dense eye-block track
@ -532,18 +477,12 @@
:stencil parent
:channels {[:xform :pos] (dense iris-block track
(provenance :roto/gaze nil))
[:geom :radius] (assoc (ch/framed radius)
:generated
(provenance :roto/iris-size
{:iris-size (:iris-size params)}))
[:geom :radius] (ch/framed radius)
[:style :color] (ch/framed :iris)}})
pupil-node (fn [id parent]
{:id id :name (clojure.core/name id) :kind :rect :parent parent :z "a1"
:stencil parent
:channels {[:geom :size] (assoc (ch/framed (:pupil-size eyes))
:generated
(provenance :roto/pupil-size
{:pupil-size (:pupil-size params)}))
:channels {[:geom :size] (ch/framed (:pupil-size eyes))
[:style :color] (ch/framed :pupil)}})
brow-node (fn [id z track]
{:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
@ -552,30 +491,25 @@
[:xform :pos] (dense brow-pos-block track
(provenance :roto/brow-raise nil))
[:style :color] (ch/framed :brow)}})]
{:nodes (merge
(when eyes
{:eye-r (eye-node :eye-r "a2" 0)
:eye-r-in (inner-node :eye-r-in :eye-r "a1" 1 (:shut-r eyes))
:iris-r (iris-node :iris-r :eye-r-in 0 (:radius-r eyes))
:pupil-r (pupil-node :pupil-r :iris-r)
:eye-l (eye-node :eye-l "a3" 2)
:eye-l-in (inner-node :eye-l-in :eye-l "a1" 3 (:shut-l eyes))
:iris-l (iris-node :iris-l :eye-l-in 1 (:radius-l eyes))
:pupil-l (pupil-node :pupil-l :iris-l)})
(when brows
{:brow-r (brow-node :brow-r "a4" 0)
:brow-l (brow-node :brow-l "a5" 1)}))
:store (apply stored (remove nil?
[eye-block iris-block brow-block brow-pos-block]))}))
{:nodes {:eye-r (eye-node :eye-r "a2" 0)
:eye-r-in (inner-node :eye-r-in :eye-r "a1" 1 (:shut-r eyes))
:iris-r (iris-node :iris-r :eye-r-in 0 (:radius-r eyes))
:pupil-r (pupil-node :pupil-r :iris-r)
:eye-l (eye-node :eye-l "a3" 2)
:eye-l-in (inner-node :eye-l-in :eye-l "a1" 3 (:shut-l eyes))
:iris-l (iris-node :iris-l :eye-l-in 1 (:radius-l eyes))
:pupil-l (pupil-node :pupil-l :iris-l)
:brow-r (brow-node :brow-r "a4" 0)
:brow-l (brow-node :brow-l "a5" 1)}
:store (stored eye-block iris-block brow-block brow-pos-block)}))
(defn- interior-part
"Freeze the pixel-derived radial contour under the mouth cavity. Missing
contours use the dense block's absence bit; contrast decides editable :vis."
[subject {:keys [analysis teeth-verts cavity-erode tongue-reject blob-grow
top-bias teeth-on teeth-smooth] :as params} absent? obs
[{:keys [analysis teeth-verts cavity-erode tongue-reject blob-grow
top-bias teeth-on teeth-smooth] :as params} absent? obs
{:keys [contours shown]}]
(let [own (partial feature/owned subject)
empty-points (vec (repeat (* 2 teeth-verts) 0))
(let [empty-points (vec (repeat (* 2 teeth-verts) 0))
values (mapv (fn [ring]
(if ring
(into [] (mapcat (juxt :x :y)) ring)
@ -583,7 +517,7 @@
blk (block {:role "teeth" :analysis (:id analysis) :params params
:tracks ["contour"]}
{:type "int16" :scale geom-scale
:features [(own :teeth)] :absent? absent?
:features [:teeth] :absent? absent?
;; Not the feature's absence: a frame no contour could be
;; extracted from has no teeth to draw whether or not the
;; teeth were occluded, and the two reasons are different facts.
@ -595,141 +529,216 @@
:top-bias top-bias :teeth-verts teeth-verts
:teeth-on teeth-on :teeth-smooth teeth-smooth}}]
{:nodes {:teeth
{:id :teeth :name "teeth" :kind :poly
:parent :mouth-in :z "a1"
{:id :teeth :name "teeth" :kind :poly :parent :mouth-in :z "a1"
:stencil :mouth-in
:channels {[:geom :pts] (dense blk 0 generated)
[:style :color] (ch/framed :teeth)
[:vis] (keyed-visibility shown generated)}}}
:store (stored blk)}))
(defn part
"One feature type: local nodes and blocks addressed by subject and feature."
[subject area params {:keys [detected presence] :as measured}]
(let [presence (into {} (map (fn [[role mask]] [(feature/owned subject role) mask])) presence)
;; ---------------------------------------------------------------------------
;; the clip
(defn clip
"Conditioned measurements -> a clip: nodes with frozen channels, plus the dense
blocks they read. `(f params inputs)`, no state.
params
:name labels the clip. It is NOT in any key: two clips of the same
footage under different names are the same analysis and the
same blocks, and sharing them is the return on addressing.
:fps the clip's rate. FRAMES is not a parameter — it is
`(count outer)`, because a freeze that could disagree with its
own input about the length of the take would.
:stage [w h] project dimensions, INDEPENDENT of the footage
:fit-motion? choose an editable real-footage default that keeps the
observed feature motion on stage
:expose the clip root's exposure grid, inherited by everything
:verts the lip rings' vertex budget
:eye-verts the eyelid rings' vertex budget
:brow-verts the brow rings' vertex budget
:aperture-cut fraction of the take's peak aperture below which the mouth
interior is not present
:head :locked | :as-filmed | :per-plate
:kept frames, for :per-plate only
:analysis the analysis record these measurements came from — detector,
VERSION, source, source cadence and pixel aspect. Its `:id` is
a content address over all of that, every block's key is a hash
over that id, and `flow/address` says why the version being in
there is the one field that must not be forgotten.
:anchor-avg
:contour-avg the stage-4 knobs. Freeze does not use them; it RECORDS them,
because `:generated` is what lets the UI offer a re-freeze at
different parameters instead of raw keys.
inputs
:ref the Procrustes reference configuration
:transforms the CONDITIONED anchor transforms
:outer :inner the CONDITIONED head-local lip rings
:eyes :brows the CONDITIONED head-local feature measurements
:teeth optional pixel-derived, conditioned radial contour
:aperture head-local aperture per frame
:detected optional per-frame face booleans
:presence optional feature-id -> per-frame booleans; false means an
unobserved feature, even if the rest of the face was found
The node tree is the one docs/animation-model.md specifies, and the two groups
are two different things wanting the same transform:
:root the clip. EXPOSURE LIVES HERE and is inherited strictly.
:face AUTHORED. where the face sits on the stage, and how big.
:head MEASURED. the head's motion, or identity.
:mouth
:mouth-in
:teeth
:eye-r / :eye-l
:eye-*-in
:iris-*
:pupil-*
:brow-r / :brow-l
`:mouth-in`'s parent is `:mouth` and that transform is identity today, so
composing it is composing identity. It is documented intent, and it is the one
place in the tree where the parent pointer is not yet doing work — the moment a
painted cel rides a moving plate it will be.
`:head` keeps its measured channels under `:measured` as well as in
`:channels`, so `head-mode` can switch shapes without the blocks or the
provenance having to be rebuilt."
[{:keys [name fps stage expose verts aperture-cut head kept
analysis anchor-avg contour-avg] :as params}
{:keys [transforms outer inner detected presence eyes brows teeth] :as inputs}]
(let [nf (count outer)
_ (doseq [[id track] presence]
(when (not= nf (count track))
(throw (ex-info "feature presence track must match the clip"
{:feature id :frames nf :actual (count track)}))))
;; Asked `(absent? feature f)`, where a nil feature is the whole face. A
;; feature with no presence track is present whenever a face was found.
absent? (when (or detected presence)
(fn [id f]
(or (and detected (not (nth detected f true)))
(and (contains? presence id)
(not (nth (get presence id) f))))))
obs {:detected detected :presence presence}]
(update (case area
:mouth (mouth-part subject absent? obs params measured)
:eye (feature-parts subject absent? obs params (select-keys measured [:eyes]))
:brow (feature-parts subject absent? obs params (select-keys measured [:brows]))
:teeth (interior-part subject params absent? obs (:teeth measured))
(throw (ex-info "unknown frozen feature type" {:area area})))
:nodes performance-nodes)))
obs {:detected detected :presence presence}
prov (fn [by extra]
{:by by :analysis (:id analysis)
:params (merge {:anchor-avg anchor-avg} extra)})
rings (block {:role "geom" :analysis (:id analysis) :params params
:tracks ["outer" "inner"]}
{:type "int16" :scale geom-scale
:features [:mouth :mouth] :absent? absent?}
obs
[(rings->flat outer verts) (rings->flat inner verts)])
;; The anchor, inverted and split into its three components. Three blocks
;; and not one: they are three channels, they have three strides, and a
;; single block would need a per-component offset table to say so.
inv (mapv invert transforms)
xf (fn [role f]
;; The head follows DETECTION and no feature's presence: an
;; occluded eye does not mean the head was not there. That is
;; what the nil feature says.
(block {:role role :analysis (:id analysis) :params params
:tracks [role]}
{:type "float32" :features [nil] :absent? absent?}
{:detected detected}
[(mapv f inv)]))
pos (xf "head-pos" (fn [t] [(:tx t) (:ty t)]))
rot (xf "head-rot" (fn [t] [(:theta t)]))
scale (xf "head-scale" (fn [t] [(:s t) (:s t)]))
;; Which knobs each channel records is not decoration, it is the
;; invalidation table written down where a re-freeze can read it. The
;; anchor depends on `anchor avg` alone. The rings depend on it and on
;; `contour avg` and on the vertex budget. The aperture depends on
;; `anchor avg` and on its own cut and NOT on `contour avg`, because
;; measure reports the inner ring's own height and nothing smooths it.
anchor-prov (prov :anchor/similarity nil)
roto (fn [by] (prov by {:verts verts :contour-avg contour-avg}))
features (when (and eyes brows) (feature-parts absent? obs params inputs))
interior (when teeth (interior-part params absent? obs teeth))
built {:name name
:fps fps
;; Tier 1 says which analysis its channels came out of, in full.
;; The id alone would make the document unreadable the first time
;; a detector upgrade orphaned a block: "sha256:7f2…" is not an
;; answer to "which model produced this take".
:analysis analysis
;; A gap changes channel state, never these IDs or pair links.
:subjects {:face-1 {:id :face-1 :params {}}}
:features (merge
{:mouth {:id :mouth :subject :face-1 :area :mouth
:nodes [:mouth :mouth-in] :params {}}}
(when features
{:eye-r {:id :eye-r :subject :face-1 :area :eye
:nodes [:eye-r :eye-r-in :iris-r :pupil-r] :params {}}
:eye-l {:id :eye-l :subject :face-1 :area :eye
:nodes [:eye-l :eye-l-in :iris-l :pupil-l] :params {}}
:brow-r {:id :brow-r :subject :face-1 :area :brow
:nodes [:brow-r] :params {}}
:brow-l {:id :brow-l :subject :face-1 :area :brow
:nodes [:brow-l] :params {}}})
(when teeth
{:teeth {:id :teeth :subject :face-1 :area :teeth
:nodes [:teeth] :params {}}}))
:groups (if features
{:eyes-1 {:id :eyes-1 :kind :eye-pair :subject :face-1
:members [:eye-r :eye-l] :params {}}}
{})
;; Stage dimensions, on the clip and not on the footage. See
;; face-placement: nothing below here knows the frame size.
:width (first stage)
:height (second stage)
;; ONE TIMELINE, and the frame count is ITS. A clip is a rate and
;; a timeline is a frame space — see arthur.domain.clip — so `nf`
;; lands here and `:fps` above, and the library a symbol will live
;; in is this same map with a second entry.
:timelines
{clip/root-id
{:id clip/root-id
:frames nf
:nodes
(merge
{:root
{:id :root :name "clip" :kind :group :parent nil :z "a1"
:time {:mode :map :expose expose}}
(defn head-part
"Freeze one subject's measured head transform from its conditioned anchor.
:face
{:id :face :name "face" :kind :group :parent :root :z "a1"
:channels (face-placement params inputs)}
THE THREE BLOCKS NAME THE SUBJECT, and that is not decoration. A block's key is
a hash over its descriptor, and the head follows DETECTION rather than any
feature's presence — so with `nil` in the feature slot, two faces tracked in one
analysis, both detected on every frame, produced byte-for-byte different
transforms under one identical key, and the second freeze's block silently
replaced the first's. The subject is the feature the head follows."
[subject {:keys [analysis anchor-avg] :as params} {:keys [transforms detected presence]}]
(let [absent? (when (or detected presence)
(fn [_ f] (and detected (not (nth detected f true)))))
inv (mapv invert transforms)
xf (fn [role f]
(block {:role role :analysis (:id analysis) :params params
:tracks [role]}
{:type "float32" :features [subject] :absent? absent?}
{:detected detected}
[(mapv f inv)]))
pos (xf "head-pos" (fn [t] [(:tx t) (:ty t)]))
rot (xf "head-rot" (fn [t] [(:theta t)]))
scale (xf "head-scale" (fn [t] [(:s t) (:s t)]))
prov {:by :anchor/similarity :analysis (:id analysis)
:params {:anchor-avg anchor-avg}}]
{:measured {[:xform :pos] (dense pos 0 prov)
[:xform :rot] (dense rot 0 prov)
[:xform :scale] (dense scale 0 prov)}
:store (stored pos rot scale)}))
:head
{:id :head :name "head" :kind :group :parent :face :z "a1"
:measured {[:xform :pos] (dense pos 0 anchor-prov)
[:xform :rot] (dense rot 0 anchor-prov)
[:xform :scale] (dense scale 0 anchor-prov)}}
;; ---------------------------------------------------------------------------
;; the clip
;; The outer lip ring is the dark band OUTSIDE the interior, and
;; that three-layer structure — dark ring, pale interior, teeth
;; — is what makes a flat shape read as an opening rather than
;; as a blob. So it keeps every frame and is never hidden.
:mouth
{:id :mouth :name "mouth" :kind :poly :parent :head :z "a1"
:channels {[:geom :pts] (dense rings 0 (roto :roto/lips-outer))
[:style :color] (ch/framed :skin-dark)}}
(defn- subject-part
"A subject's drawing, metadata and blocks. Node names are timeline-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))
parts (mapv #(part subject % params inputs) areas)
head (head-part subject params inputs)
features (cond-> {:mouth [:mouth [:mouth :mouth-in]]}
(and eyes brows)
(merge {:eye-r [:eye [:eye-r :eye-r-in :iris-r :pupil-r]]
: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)
: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
:nodes nodes :params {}}])) features)
:groups (if (and eyes brows)
{(own :eyes) {:id (own :eyes) :kind :eye-pair :subject subject
:members [(own :eye-r) (own :eye-l)] :params {}}}
{})
:store (into (:store head) (mapcat :store) parts)}))
(defn clip
"Subject-id -> conditioned measurements becomes a library of face timelines.
: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.
Subjects share a source frame space. :head and :anchors may be overridden
per subject; all other freeze settings come from params."
[{:keys [name fps stage expose head anchors] :as params} subjects]
(when-not (and (map? subjects) (seq subjects)
(every? keyword? (keys subjects))
(not-any? #{:main :root :face} (keys subjects)))
(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))
_ (when-not (and (= 1 (count lengths)) (pos? (first lengths)))
(throw (ex-info "subjects need the same positive frame count"
{:frames (vec lengths)})))
nf (first lengths)
merged (fn [k] (into {} (mapcat (comp k second)) parts))
built {:name name :fps fps :analysis (:analysis params)
: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
:nodes (into {:root {:id :root :name "clip" :kind :group :z "a1"
:time {:mode :map :expose expose}}
:face {:id :face :name "source placement" :kind :group
:parent :root :z "a1"
:channels (face-placement params subjects)}}
(map-indexed
(fn [i [id _]]
[id {:id id :kind :symbol :of id :parent :face
:z (str "a" i)}]))
ordered)}}
(map (fn [[id part]] [id (:timeline part)])) parts)}]
(doseq [[subject inputs] ordered
[id track] (:presence inputs)]
(when-not (and (= nf (count track))
(= subject (get-in built [:features (feature/owned subject id) :subject])))
(throw (ex-info "presence must name this subject's feature and span the take"
{:subject subject :feature id :frames nf :actual (count track)}))))
{:store (merged :store)
:clip (reduce (fn [c [subject inputs]]
(head-mode {:subject subject :mode (or (:head inputs) head)
:anchors (get inputs :anchors anchors)}
{:clip c}))
built ordered)}))
:mouth-in
{:id :mouth-in :name "mouth interior" :kind :poly
:parent :mouth :z "a2"
:channels {[:geom :pts] (dense rings 1 (roto :roto/lips-inner))
[:style :color] (ch/framed :mouth-dark)
[:vis] (visibility params inputs
(prov :roto/mouth-aperture
{:aperture-cut aperture-cut}))}}}
(:nodes features) (:nodes interior))}}}
;; Tier 2, behind a handle, and now behind a content address: every key is
;; a sha256 over the analysis, the settings and the absence data that
;; produced the bytes under it. Nothing above this line changed when they
;; stopped being "take/geom", which is the point of a handle.
store (merge (stored rings pos rot scale)
(:store features) (:store interior))]
(doseq [id (keys presence)]
(when-not (contains? (:features built) id)
(throw (ex-info "presence track names no feature in this clip"
{:feature id :features (keys (:features built))}))))
{:store store
:clip (head-mode {:mode head :kept kept} {:clip built :store store})}))

392
frontend/src/arthur/flow/ingest.cljs
View file

@ -4,9 +4,9 @@
THE MEASURED PIXELS COME OUT OF A VIDEO NOW, not out of a PNG per frame. The old
arrangement stored 112MB for a 7.6-second take and 1.1GB at the 900-frame limit;
the same footage is a 6MB H.264 proxy. What that cost was the property a PNG
sequence gave for free — that asking for frame 12 gets frame 12 — and `decode!`
below is how it is bought back."
the same footage is a 6MB H.264 proxy the page steps through. What that costs is
the property a PNG sequence gave for free — that asking for frame 12 gets frame
12 — so `frame!` below buys it back explicitly, and refuses to guess."
(:require [arthur.fx.http :as http]
[clojure.string :as str]))
@ -50,8 +50,8 @@
;; it has a specific cause and a specific fix: this footage was extracted
;; before the proxy existed, and its frames were stored as PNGs that the
;; measurement path no longer reads.
(when-not (and (string? (:stream m)) (seq (:stream m)))
(throw (ex-info "this footage has no decodable stream — re-extract it from its source"
(when-not (and (string? (:video m)) (seq (:video m)))
(throw (ex-info "this footage has no video to measure — re-extract it from its source"
{:footage (:id m)})))
(when-not (= frames (count urls))
;; The count is the manifest's and the URLs are the manifest's, so a
@ -92,9 +92,6 @@
(defn video-url [manifest]
(:video manifest))
(defn stream-url [manifest]
(:stream manifest))
(defn frame-url
"The tracing still for one frame. A reference image for drawing over — the
landmarks and the mouth crops come from the video, not from these."
@ -111,194 +108,219 @@
(set! (.-src image) src)))))
;; ---------------------------------------------------------------------------
;; decoding the proxy
;;
;; WEBCODECS, NOT SEEKING, and the seeking is worth a paragraph because three
;; separate failures came out of it. A `<video>` cannot be asked for frame 12: it
;; can be asked for a TIME, and which frame that lands on is up to the engine.
;; Measured on a video whose every frame carries its own index in its pixels,
;; Firefox 156 returned the wrong frame for 4 of 40 seeks aimed at the middle of
;; each frame, and 15 of 40 aimed at the start — and `requestVideoFrameCallback`,
;; the thing that is supposed to say which frame arrived, reported a different
;; frame from the one actually on screen 27 times out of 40. There is no way to
;; verify a seek when the verification is the part that is wrong.
;;
;; So the page decodes instead. `VideoDecoder` takes coded chunks and returns
;; exactly one frame per chunk, in order — measured 120 of 120 in order in both
;; Firefox and Chrome. The server hands us the proxy's video as a raw Annex-B
;; stream, which needs no demuxer: NAL start codes are findable in a loop. And
;; because the proxy is encoded with no B-frames, decode order is presentation
;; order, so ACCESS UNIT k IS FRAME k. No timestamps are interpreted, no clock is
;; reconciled, and nothing here can be off by one.
;; walking the proxy, one frame at a time
(defn seek-time
"When to ask the video for source frame `i`: the MIDDLE of the frame, not its
start.
A frame occupies the half-open interval `[i/fps, (i+1)/fps)`, so `i/fps` sits
exactly on a boundary — and a boundary is where a seek lands on whichever side
the container's timebase rounds to. Measured over 91 frames: seeking to `i/fps`
produced the previous frame 31 times, and seeking to the middle was exact on all
91. Half a frame of slack in both directions is the entire fix."
[fps i]
(/ (+ i 0.5) fps))
(defn presented-frame
"Which source frame a `mediaTime` from requestVideoFrameCallback refers to.
`mediaTime` is the presented frame's own START — measured on 91 frames at 12fps
it came back as an exact multiple of the frame duration — so this is the inverse
of `i/fps` and NOT of `seek-time`. The two are asymmetric on purpose: we aim
half a frame late because a seek target is fuzzy, and read back exactly because
a presentation timestamp is not."
[fps media-time]
(js/Math.round (* media-time fps)))
(defn frame-ms
"When source frame `i` happens, in milliseconds of footage.
What `flow/detect` hands MediaPipe as the frame's timestamp. Real elapsed time
rather than the frame number, because the tracker reads the gap between
timestamps as motion — see `detect/detect!` — and strictly increasing, which its
input stream requires."
timestamps as motion — see `detect/detect!`."
[fps i]
(/ (* i 1000) fps))
(defn access-units
"An Annex-B H.264 stream -> one `{:from :to :key?}` per coded frame.
A NAL unit starts at a three- or four-byte start code, and an access unit is the
parameter sets and SEI leading up to and including one coded slice. So: a new
unit begins at the first non-slice NAL after a slice. Types 1 and 5 are the
slice types — 5 is an IDR, which is what makes a chunk a keyframe.
(def ^:private seek-timeout-ms
"How long one frame may take to arrive before the run gives up.
Twenty-five lines instead of a demuxer, and the reason it is only twenty-five is
that the stream was produced for this: constant rate, no B-frames, one slice per
frame."
[^js bytes]
(let [n (.-length bytes)
starts (loop [i 0 out (transient [])]
(if (>= i (- n 3))
(persistent! out)
(let [a (aget bytes i) b (aget bytes (inc i)) c (aget bytes (+ i 2))]
(cond
(and (zero? a) (zero? b) (= 1 c))
(recur (inc i) (conj! out i))
Long, because the first seek of a take also opens the file and fills a buffer,
and short enough that a video the browser cannot decode fails with a sentence
instead of hanging with a spinner."
10000)
(and (zero? a) (zero? b) (zero? c) (= 1 (aget bytes (+ i 3))))
(recur (+ i 2) (conj! out i))
:else (recur (inc i) out)))))]
(loop [ks 0 current nil saw-slice? false out []]
(if (= ks (count starts))
(if current (conj out current) out)
(let [start (nth starts ks)
end (if (< (inc ks) (count starts)) (nth starts (inc ks)) n)
header (aget bytes (+ start (if (= 1 (aget bytes (+ start 2))) 3 4)))
kind (bit-and header 0x1f)
slice? (or (= 1 kind) (= 5 kind))
[out current saw-slice?] (if (and slice? saw-slice?)
[(conj out current) nil false]
[out current saw-slice?])
current (or current {:from start :to end :key? false})]
(recur (inc ks)
(assoc current :to end :key? (or (:key? current) (= 5 kind)))
(or saw-slice? slice?)
out))))))
(defn stream!
"Fetch the elementary stream and cut it into one chunk per frame."
[src frames]
(-> (js/fetch src)
(.then (fn [^js response]
(when-not (.-ok response)
(throw (ex-info (str "the footage's video stream did not load: "
(.-status response))
{:src src})))
(.arrayBuffer response)))
(.then (fn [buffer]
(let [units (access-units (js/Uint8Array. buffer))]
(when-not (= (count units) frames)
(throw (ex-info (str "the video stream holds " (count units)
" coded frames and the manifest says " frames)
{:units (count units) :frames frames})))
{:bytes (js/Uint8Array. buffer) :units (vec units)})))))
(def ^:private decode-lookahead
"How many chunks may be in the decoder at once.
Backpressure, and not a tuning knob to leave at infinity: a 900-frame take at
1440x1920 is gigabytes of decoded frames, so feeding the whole stream in and
letting the output callback keep up is how the tab dies. Small enough to bound
that, and more than one so the decoder is never idle waiting on us."
4)
(defn decode!
"Decode every frame in order, calling `(on-frame i frame)` for each.
`on-frame` runs while the frame is alive and must not retain it — this closes it
as soon as the call returns, because a `VideoFrame` holds decoder memory and the
decoder stalls when it runs out. It may return a promise, which the walk waits
for before feeding more; that is what lets a synchronous MediaPipe call and a
repaint happen between frames without the decoder running ahead.
Resolves when the last frame has been handed over."
[{:keys [bytes units]} fps width height on-frame]
(defn- await-frame!
"One presentation, with its raw index. `nil` if none arrives in time."
[^js video fps at]
(js/Promise.
(fn [resolve _reject]
(let [settled (volatile! false)
give (fn [v] (when-not @settled (vreset! settled true) (resolve v)))]
(.requestVideoFrameCallback
video (fn [_now metadata]
(give (presented-frame fps (.-mediaTime metadata)))))
(js/setTimeout #(give nil) seek-timeout-ms)
(set! (.-currentTime video) at)))))
(defn calibrate!
"What the browser CALLS the first frame it will show us.
Not always zero, and that is not the browser being wrong. A container can carry
an edit list — ffmpeg writes one to absorb an encoder's reordering delay — and
then `currentTime` counts from the start of the edited presentation while the
`mediaTime` on a frame counts from the start of the media. The two differ by a
constant, and the frame at `currentTime` 0 can honestly report a `mediaTime` of
two frames in.
SO THE CONSTANT IS MEASURED ONCE AND SUBTRACTED, rather than corrected for by
seeking. Seeking cannot fix it: when the offset is positive, source frame 0
would have to be found BEFORE the start of the video, every attempt clamps at
zero, and the walk reports `never presented frame 1; it offered 2` forever. The
first frame the element presents IS frame 0 — it is what a viewer sees at time
zero, and the audio clock this take plays against starts in the same place — so
its own label is the origin everything else is counted from."
[^js video fps]
(-> (await-frame! video fps (seek-time fps 0))
(.then (fn [base]
(when (nil? base)
(throw (ex-info "the video presented no frame at all; it cannot be walked"
{})))
base))))
(defn video!
"Load the proxy as a decodable, seekable element, and find its origin.
`preload=auto` and nothing else: the element is never added to the document and
never played. It is a decoder with a seek function, and the only reason it is a
DOM element rather than a `VideoDecoder` is that a `VideoDecoder` needs the
container demuxed before it can be handed a single frame, and this does not."
[src fps width height]
(-> (js/Promise.
(fn [resolve reject]
(let [video (.createElement js/document "video")]
(set! (.-muted video) true)
(set! (.-playsInline video) true)
(set! (.-preload video) "auto")
(set! (.-crossOrigin video) "anonymous")
(set! (.-onerror video)
(fn [_]
(reject (ex-info (str "the browser could not decode this footage's video"
(when-let [e (.-error video)]
(str " (" (.-message e) ")")))
{:src src}))))
(set! (.-onloadeddata video)
(fn [_]
(cond
(not (fn? (.-requestVideoFrameCallback video)))
(reject (ex-info (str "this browser has no requestVideoFrameCallback, so "
"which frame is on screen cannot be established")
{}))
(not= [(.-videoWidth video) (.-videoHeight video)] [width height])
(reject (ex-info "the video's size disagrees with the footage manifest"
{:manifest [width height]
:video [(.-videoWidth video) (.-videoHeight video)]}))
:else (resolve video))))
(set! (.-src video) src))))
(.then (fn [video]
(-> (calibrate! video fps)
;; Calibration left the element ON frame 0, so the walk starts
;; already holding it. `current` is what is on screen now.
(.then (fn [base] {:el video :base base :current (atom 0)})))))))
(def ^:private seek-attempts
"How many times one frame may be asked for before the run gives up.
More than one because the browser is allowed to disagree with us about where a
frame starts, and few because each attempt corrects by the exact size of the
disagreement — so a constant offset is gone on the second try and anything still
wrong on the sixth is not an offset."
6)
(defn frame!
"Seek to source frame `i` and resolve once the browser has PRESENTED it.
COUNTED FROM THE CALIBRATED ORIGIN. `base` is what the browser called the first
frame it showed (see `calibrate!`), so the frame we want is the one whose raw
index is `base + i`. Subtracting a measured constant is what makes a container
with an edit list walk the same as one without, and it is the half that seeking
cannot do: when the offset is positive, frame 0 lies before the start of the
video and no amount of re-seeking will reach it.
IT STILL CORRECTS TOWARDS THE FRAME IT WANTS, for whatever the constant does not
explain. A wrong frame is not merely an error to report, it is a MEASUREMENT of
how far off the aim was, and the next attempt shifts by exactly that. Re-seeking
rather than only re-listening is load-bearing: nothing further is ever presented
to a paused video that has not been asked to move, so an earlier version that
re-armed the callback without seeking again starved until its timeout.
It fails loudly rather than accepting a near miss. A one-frame slip between the
landmarks and the audio is not something anyone finds by looking at the result,
so exhausting the attempts ends the run and reports every frame that was offered
and where it was asked from."
[{:keys [^js el base current]} fps i]
(if (= @current i)
;; Already on screen. Seeking to where we already are presents NOTHING — a
;; paused element with an unchanged frame fires no callback — so asking again
;; would wait out the timeout. This is frame 0 straight after `calibrate!`,
;; and it is the difference between a walk that starts and one that hangs.
(js/Promise.resolve el)
(js/Promise.
(fn [resolve reject]
(if-not (exists? js/VideoDecoder)
(reject (ex-info (str "this browser has no WebCodecs VideoDecoder, which is "
"what reads footage a frame at a time")
{}))
(let [total (count units)
next-in (volatile! 0)
done-out (volatile! 0)
failed (volatile! false)
;; `taken` is claimed as a frame ARRIVES. `done-out` counts frames
;; FINISHED, and is what backpressure and completion read. They are
;; two different numbers whenever `on-frame` yields, which it does —
;; reading `done-out` as the index let frames 0 and 1 both claim 0,
;; call the detector twice at timestamp 0, and get the run killed by
;; `Packet timestamp mismatch ... expected 1 but received 0`.
taken (volatile! 0)
;; And the work is CHAINED rather than started, because the detector
;; is a tracker fed one frame at a time in order. Two overlapping
;; `detect!` calls are not slow, they are wrong.
chain (volatile! (js/Promise.resolve))
decoder (volatile! nil)
fail! (fn [error]
(when-not @failed
(vreset! failed true)
(when-let [^js d @decoder]
(try (when-not (= "closed" (.-state d)) (.close d))
(catch :default _ nil)))
(reject error)))]
(letfn [(feed! []
(while (and (not @failed)
(< @next-in total)
(< (- @next-in @done-out) decode-lookahead))
(let [i @next-in
{:keys [from to key?]} (nth units i)]
(vreset! next-in (inc i))
(.decode ^js @decoder
(js/EncodedVideoChunk.
#js {:type (if key? "key" "delta")
:timestamp (js/Math.round (/ (* i 1e6) fps))
:duration (js/Math.round (/ 1e6 fps))
:data (.subarray bytes from to)})))))]
(vreset!
decoder
(js/VideoDecoder.
#js {:output
(fn [^js frame]
(if @failed
(.close frame)
(let [i @taken]
(vreset! taken (inc i))
(vreset!
chain
(.then
@chain
(fn []
(if @failed
(do (try (.close frame) (catch :default _ nil)) nil)
(-> (js/Promise.resolve
(try (on-frame i frame)
(catch :default error (js/Promise.reject error))))
(.then (fn [_]
(try (.close frame) (catch :default _ nil))
(vreset! done-out (inc i))
(if (= (inc i) total)
(do (.close ^js @decoder)
(resolve total))
(feed!))))
(.catch (fn [error]
(try (.close frame) (catch :default _ nil))
(fail! error)
nil))))))))))
:error (fn [^js e]
(fail! (ex-info (str "the browser could not decode this "
"footage: " (.-message e))
{})))}))
(.configure ^js @decoder
#js {:codec "avc1.640028"
:codedWidth width :codedHeight height
:optimizeForLatency true})
(feed!)))))))
(let [settled (volatile! false)
offered (volatile! [])
finish (fn [f] (when-not @settled (vreset! settled true) (f)))
duration (or (.-duration el) 0)
describe (fn []
(if (seq @offered)
(str/join ", "
(map (fn [[idx at]]
(str (inc idx) " (asked at " (.toFixed at 4) "s)"))
@offered))
"nothing at all"))
timer (js/setTimeout
#(finish
(fn []
(reject (ex-info (str "the video never presented frame " (inc i)
"; it offered " (describe))
{:frame i :base base :offered @offered}))))
seek-timeout-ms)
seek! (fn [at]
;; A repeat of the current position is not a seek and presents
;; nothing, so nudge within the frame rather than stall.
(let [at (min (max at 0) (max 0 (- duration 1e-3)))
at (if (= at (.-currentTime el)) (+ at (/ 0.25 fps)) at)]
(set! (.-currentTime el) at)))]
(letfn [(attempt [n at]
(.requestVideoFrameCallback
el
(fn [_now metadata]
(when-not @settled
(let [presented (- (presented-frame fps (.-mediaTime metadata)) base)]
(cond
(= presented i)
(do (js/clearTimeout timer)
(reset! current i)
(finish #(resolve el)))
(< n seek-attempts)
(let [next-at (- at (/ (- presented i) fps))]
(vswap! offered conj [presented at])
(attempt (inc n) next-at)
(seek! next-at))
:else
(do (vswap! offered conj [presented at])
(js/clearTimeout timer)
(finish
(fn []
(reject (ex-info
(str "the video kept presenting the wrong frame for "
(inc i) "; it offered " (describe))
{:frame i :base base :offered @offered})))))))))))]
(let [at (seek-time fps i)]
(attempt 1 at)
(seek! at))))))))

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

@ -1,141 +0,0 @@
(ns arthur.flow.regenerate
"Recompute a changed feature from retained source tracks, then replace only
channels owned by that feature. Upload remains project/save's ordinary job."
(:require [arthur.domain.feature :as feature]
[arthur.domain.params :as params]
[arthur.flow.address :as address]
[arthur.flow.freeze :as freeze]
[arthur.flow.take :as take]))
(defn- settings
"One feature's MEASUREMENT inputs. The teeth read the mouth's aperture cut
because `condition/interior` will not smooth a contour on a frame the mouth is
shut on: an input edge between two features, and the only one there is."
[clip fid]
(let [f (get-in clip [:features fid])
mouth (first (for [[id peer] (:features clip)
:when (and (= :mouth (:area peer))
(= (:subject f) (:subject peer)))] id))]
(cond-> (feature/effective-params clip fid)
(and (= :teeth (:area f)) mouth)
(assoc :aperture-cut (:aperture-cut (feature/effective-params clip mouth))))))
(defn- reads
"The knob values one feature's frozen channels actually depend on.
Narrower than its measurement inputs, and that difference IS the dirty-set
calculation. `:contour-avg` is a subject setting every feature inherits and the
teeth block does not read, so inheriting a knob and being stale because of it are
not the same thing. `address/area-knobs` is what knows which is which, over the
table `address-test` asserts by biconditional — so there is no second per-knob
list here to drift away from the one that is checked."
[clip fid]
(select-keys (settings clip fid)
(address/area-knobs (get-in clip [:features fid :area]))))
(defn- replace-feature [entry fragment fid]
(let [paths (for [id (get-in entry [:clip :features fid :nodes])
[prop channel] (get-in fragment [:nodes id :channels])
:when (:generated channel)]
[id prop channel])]
(-> (reduce (fn [entry [id prop channel]]
(let [at [:clip :timelines (get-in entry [:clip :features fid :timeline])
:nodes id :channels prop]
old (get-in entry at)]
(assoc-in entry at
(cond-> channel
(contains? old :over) (assoc :over (:over old))))))
entry paths)
(update :store merge (:store fragment)))))
(defn plan
"The changed document, the feature IDs an edit dirties, and the subject they
belong to. Also reports tier-2 block roles from the address table for the
debug UI."
[clip {:keys [scope id knob value]}]
(let [area (get-in params/definitions [knob :area])
collection (case scope
:subject :subjects :feature :features :group :groups
(throw (ex-info "unknown setting scope" {:scope scope})))
owner (get-in clip [collection id])]
(when-not (and owner (params/valid-value? knob value)
(case scope
:subject (= area :subject)
:feature (= area (:area owner))
:group (and (= area :eye) (= :eye-pair (:kind owner)))))
(throw (ex-info "invalid scoped setting" {:scope scope :id id
:knob knob :value value})))
(let [changed (assoc-in clip [collection id :params knob] value)
subject (if (= scope :subject) id (:subject owner))
;; Every feature of the subject is a candidate, not just the edited
;; object's own members, because a knob can reach a feature it does not
;; belong to: `:aperture-cut` is a mouth setting that the TEETH read.
;; `reads` is what narrows this back down, and it is the only thing
;; that does — no per-knob cases here, in either direction.
candidates (sort-by str (for [[fid f] (:features clip)
:when (= subject (:subject f))] fid))]
{:changed changed
:subject subject
:features (vec (filter #(not= (reads clip %) (reads changed %)) candidates))
:roles (address/invalidates knob)})))
(defn- regenerate-feature
"One dirty feature, re-measured through the shared anchor and re-frozen. A brow
reads the eye corners and the teeth read mouth aperture; `take/measure-part`
owns those input edges, and neither one is a request to freeze the other
feature."
[base-params base source-inputs entry fid]
(let [{:keys [area subject]} (get-in entry [:clip :features fid])
params (merge base-params (settings (:clip entry) fid))]
(when (and (= :teeth area) (nil? (:interior source-inputs)))
(throw (ex-info "teeth regeneration needs retained pixel measurements"
{:feature fid})))
(replace-feature entry
(freeze/part subject area params
(take/measure-part area params source-inputs @base))
fid)))
(defn- regenerate-head
"Re-freeze ONE SUBJECT's head transform, which is a different job from a
feature's: its only input is that subject's conditioned anchor, and it owns no
channels to replace. The authored `:channels` follow the measurement while they
still ARE the measurement, and are left alone once somebody has placed the head
by hand."
[entry params base subject]
(let [baked (freeze/head-part subject params @base)
at [:clip :timelines subject :nodes :head]
old (get-in entry at)
measured (:measured baked)]
(cond-> (-> entry
(assoc-in (conj at :measured) measured)
(update :store merge (:store baked)))
(= (:channels old) (:measured old))
(assoc-in (conj at :channels) measured))))
(defn change
"One scoped static edit. `source-inputs` holds dense landmarks and, when the
teeth are dirty, retained pixel measurements. No IO or app-db here."
[{:keys [clip source-inputs] :as entry} edit]
(let [{:keys [changed subject features]} (plan clip edit)
;; THE EDITED SUBJECT'S OWN LANDMARKS. Retained source is per subject —
;; one video, one dense track per tracked face — so re-measuring the
;; second face through the first one's anchor is the mistake this lookup
;; exists to prevent.
source-inputs (get-in source-inputs [:subjects subject])
_ (when-not (:dense source-inputs)
(throw (ex-info "regeneration needs retained source landmarks"
{:subject subject})))
base-params (merge take/knobs
{:fps (:fps changed)
:aspect (get-in changed [:analysis :aspect])
:analysis (:analysis changed)})
;; One conditioned anchor for the whole edit, and it is the SUBJECT's.
;; `:anchor-avg` is a subject setting, so the shared upstream measurement
;; is not read off whichever dirty feature happened to sort first — and
;; the head below does not need a feature to exist at all.
anchor-params (merge base-params (params/for-area :subject)
(get-in changed [:subjects subject :params]))
base (delay (take/anchor-base anchor-params source-inputs))]
(cond-> (reduce (partial regenerate-feature base-params base source-inputs)
(assoc entry :clip changed) features)
(= :anchor-avg (:knob edit)) (regenerate-head anchor-params base subject))))

217
frontend/src/arthur/flow/source.cljs
View file

@ -1,7 +1,7 @@
(ns arthur.flow.source
"Retained analysis: three raw source blocks and an optional addressed interior
measurement block. Everything after this boundary can run without PNGs or
MediaPipe. Mouth crops retain pixels for settings that change the measurement."
"The pixel-dependent result of analyzing footage, stored as three ordinary
content-addressed blocks. Everything after this boundary can run without PNGs
or MediaPipe. The mouth crops hold raw pixels and an un-eroded lip ring."
(:require [arthur.domain.landmarks :as lm]
[arthur.domain.wire :as wire]
[arthur.flow.address :as address]
@ -9,107 +9,26 @@
(def roles ["source/dense" "source/detected" "source/crops"])
(defn- interior-address [analysis subject settings frames]
(let [verts (:teeth-verts settings)
stride (+ 2 (* 2 verts))]
(address/block {:role "source/interior" :analysis analysis
:params settings
:tracks ["contrast" "area" "contour"]
:features [subject] :observation nil
:layout {:type "float64" :frames frames :verts verts
:stride stride}})))
(defn measure-crops [params crops]
(mapv (fn [crop]
(if crop
(interior/measure params (:box crop) #js {:data (:data crop)})
{:contour nil :contrast 0 :area 0 :debug nil}))
crops))
(defn interior-key [analysis subject settings frames]
(:key (interior-address analysis subject settings frames)))
(defn interior-block
"Retain one subject's pixel measurements before any head-local transform or
smoothing."
[analysis subject settings measures]
(let [frames (count measures)
{:keys [key descriptor]}
(interior-address analysis subject settings frames)
verts (:teeth-verts settings)
stride (+ 2 (* 2 verts))
data (js/Float64Array. (* frames stride))]
(doseq [f (range frames)]
(let [{:keys [contrast area contour]} (nth measures f)
at (* f stride)]
(aset data at (or contrast 0))
(aset data (inc at) (or area 0))
(if contour
(do
(when-not (= verts (count contour))
(throw (ex-info "interior contour vertex count disagrees with settings"
{:frame f :expected verts :actual (count contour)})))
(doseq [i (range verts)]
(aset data (+ at 2 (* 2 i)) (:x (nth contour i)))
(aset data (+ at 3 (* 2 i)) (:y (nth contour i)))))
(aset data (+ at 2) js/NaN))))
{:role "source/interior" :key key :descriptor descriptor :data data}))
(defn unpack-interior [^js response settings frames]
(let [descriptor (js->clj (js/JSON.parse (.-descriptor response))
:keywordize-keys true)
layout (:layout descriptor)
data (wire/typed (:type layout) (.-data response))
verts (:teeth-verts settings)
stride (+ 2 (* 2 verts))]
(when-not (and (= "source/interior" (:role descriptor))
(= frames (:frames layout)) (= verts (:verts layout))
(= stride (:stride layout))
(= (* frames stride) (.-length data)))
(throw (ex-info "saved interior block has the wrong layout"
{:layout layout :frames frames :verts verts})))
(mapv (fn [f]
(let [at (* f stride)]
{:contrast (aget data at) :area (aget data (inc at))
:contour (when-not (js/Number.isNaN (aget data (+ at 2)))
(mapv (fn [i]
{:x (aget data (+ at 2 (* 2 i)))
:y (aget data (+ at 3 (* 2 i)))})
(range verts)))}))
(range frames))))
(defn measure-crop
"One mouth crop's interior, or the empty measurement for a frame with no face.
Singular because the caller that matters measures a crop the moment it has one,
while the rest of the frame's pixels are still on the canvas — see
`events/footage`. Measuring all of them afterwards is the same arithmetic and
ten seconds of a frozen page."
[params crop]
(if crop
(interior/measure params (:box crop) #js {:data (:data crop)})
{:contour nil :contrast 0 :area 0 :debug nil}))
(defn- named [role analysis subject tracks layout data]
(defn- named [role analysis tracks layout data]
(merge (address/block {:role role :analysis analysis :params {}
:tracks tracks :features [subject] :observation nil
:tracks tracks :features [] :observation nil
:layout layout})
{:role role :data data}))
(defn pack
"One SUBJECT's dense landmarks, mask, crops and optional pixel measurements ->
source blocks.
`:interior-settings` is not optional when `:interior` is present: the block is
addressed BY those knobs, and defaulting them here would name a block after
settings its bytes did not come from — a content address that lies, which is the
one failure the key exists to prevent.
`subject` is in every block's descriptor, and it has to be. These four blocks
carry no feature — they are the raw analysis, upstream of any part — so two
faces tracked in one video would otherwise produce different bytes under one
identical key, and the second face's landmarks would replace the first's in the
store. That is the same failure `freeze/head-part` guards against one stage
later, for the same reason."
[analysis subject {:keys [dense detected crops interior interior-settings]}]
"Dense landmarks, detection mask and raw RGBA mouth crops -> source blocks."
[analysis {:keys [dense detected crops]}]
(let [frames (count dense)
points (count (first dense))]
(when-not (and (pos? frames) (pos? points)
(= frames (count detected) (count crops))
(or (nil? interior) (= frames (count interior)))
(every? #(= points (count %)) dense))
(throw (ex-info "source tracks must have the same frame and landmark counts"
{:frames frames :points points})))
@ -132,67 +51,35 @@
(aset landmarks (+ base 2) z)))
(when-let [crop (nth crops f)]
(.set pixels (:data crop) (nth offsets f))))
(cond-> {"source/dense"
(named "source/dense" analysis subject ["landmarks"]
{:type "float64" :frames frames :points points
:stride (* 3 points)}
landmarks)
"source/detected"
(named "source/detected" analysis subject ["detected"]
{:type "uint8" :frames frames :stride 1} mask)
"source/crops"
(named "source/crops" analysis subject ["rgba"]
{:type "uint8" :frames frames :boxes boxes :offsets offsets}
pixels)}
interior (assoc "source/interior"
(interior-block
analysis subject
(or interior-settings
(throw (ex-info "an interior block needs the settings its measurements were taken at"
{:frames (count interior)})))
interior))))))
{"source/dense" (named "source/dense" analysis ["landmarks"]
{:type "float64" :frames frames :points points :stride (* 3 points)}
landmarks)
"source/detected" (named "source/detected" analysis ["detected"]
{:type "uint8" :frames frames :stride 1} mask)
"source/crops" (named "source/crops" analysis ["rgba"]
{:type "uint8" :frames frames :boxes boxes :offsets offsets}
pixels)})))
(defn pack-subjects
"Every tracked subject's source blocks: `{subject {role block}}`.
One video, one analysis, one set of blocks PER FACE. They are separate blocks
and not one block with a subject axis, because a face can be re-measured on its
own — a knob dragged on the second person re-reads the second person's
landmarks — and because that is what makes each one's content address name
exactly the bytes it covers."
[analysis by-subject]
(into {} (map (fn [[subject inputs] ] [subject (pack analysis subject inputs)]))
by-subject))
(defn- flatten-blocks
"`{subject {role block}}` -> one flat seq, in a stable order."
[by-subject wanted]
(for [[_ blocks] (sort-by (comp str key) by-subject)
role wanted
:when (contains? blocks role)]
(get blocks role)))
(defn block-keys
"The keys of every subject's source blocks, in the order they upload."
[by-subject]
(mapv :key (flatten-blocks by-subject roles)))
(defn wire-blocks [by-subject]
(defn wire-blocks [blocks]
(into-array
(map (fn [{:keys [key descriptor data]}]
#js {:key key :descriptor descriptor :data (wire/base64 data)})
(flatten-blocks by-subject roles))))
(map (fn [role]
(let [{:keys [key descriptor data]} (get blocks role)]
#js {:key key :descriptor descriptor :data (wire/base64 data)}))
roles)))
(defn upload-blocks [by-subject]
(into-array
(map (fn [{:keys [key descriptor data]}]
#js {:key key :descriptor descriptor :data data})
(flatten-blocks by-subject (conj roles "source/interior")))))
(defn- unpack-one
"One subject's three blocks -> its inputs for measurement and freeze."
[by-role [width height]]
(let [_ (when-not (= (set roles) (set (keys by-role)))
(defn unpack
"The three block-detail responses -> inputs for measurement and freeze."
[^js responses [width height]]
(let [by-role (into {}
(map (fn [^js response]
(let [descriptor (js->clj (js/JSON.parse (.-descriptor response))
:keywordize-keys true)]
[(:role descriptor)
{:layout (:layout descriptor)
:data (wire/typed (get-in descriptor [:layout :type])
(.-data response))}]))
(array-seq responses)))
_ (when-not (= (set roles) (set (keys by-role)))
(throw (ex-info "analysis is missing source blocks" {:roles (keys by-role)})))
{:keys [layout data]} (get by-role "source/dense")
frames (:frames layout)
@ -229,29 +116,3 @@
{:dense dense :detected detected :crops crops :dimensions [width height]
:missing (count (remove true? detected))
:first-real (first (keep-indexed (fn [i present?] (when present? i)) detected))})))
(defn unpack
"Every subject's block-detail responses -> `{:subjects {id inputs}}`.
WHICH SUBJECT A BLOCK BELONGS TO IS READ OFF ITS DESCRIPTOR, not off the order
the server returned it in. The descriptor is the thing the key is a hash of, so
it is the only statement about a block that cannot have drifted from its bytes."
[^js responses dimensions]
(let [parsed (map (fn [^js response]
(let [descriptor (js->clj (js/JSON.parse (.-descriptor response))
:keywordize-keys true)]
{:subject (keyword (first (:features descriptor)))
:role (:role descriptor)
:block {:layout (:layout descriptor)
:data (wire/typed (get-in descriptor [:layout :type])
(.-data response))}}))
(array-seq responses))]
(when (some (comp nil? :subject) parsed)
(throw (ex-info "a source block does not say which subject it came from"
{:roles (mapv :role parsed)})))
{:subjects
(into {}
(map (fn [[subject entries]]
[subject (unpack-one (into {} (map (juxt :role :block)) entries)
dimensions)]))
(group-by :subject parsed))}))

65
frontend/src/arthur/flow/take.cljs
View file

@ -1,7 +1,6 @@
(ns arthur.flow.take
"The shared landmark-to-channel path for synthetic and detected takes."
(:require [arthur.flow.address :as address]
[arthur.flow.detect :as detect]
[arthur.flow.condition :as condition]
[arthur.flow.condition.brows :as condition-brows]
[arthur.flow.condition.eyes :as condition-eyes]
@ -28,7 +27,7 @@
:aspect aspect
;; How the detector was run, not just which one it was. See
;; `flow/address/analysis-descriptor`.
:mode "video" :tracking detect/settings}))))
:mode "video"}))))
(defn measure
"Condition the anchor before measuring rings through it."
@ -61,72 +60,21 @@
:detected detected
:presence presence)))
(defn anchor-base
"Shared upstream measurement for a feature regeneration."
[{:keys [aspect] :as params} {:keys [dense detected presence]}]
(let [fitted (anchor/fit {:aspect aspect} {:dense dense})]
(assoc (condition/anchor params fitted)
:detected detected :presence presence)))
(defn measure-part
"Recompute one feature type through the shared conditioned anchor. A brow
reads the eye corners, and teeth read mouth aperture; these are input edges,
not requests to freeze those other features."
[area {:keys [aspect] :as params}
{:keys [dense detected interior presence]} {:keys [transforms] :as base}]
(let [mouth (fn []
(mouth/measure {:aspect aspect}
{:dense dense :transforms transforms}))
eyes (fn []
(eyes/measure params {:dense dense :transforms transforms
:detected detected :presence presence}))]
(merge (select-keys base [:detected :presence])
(case area
:mouth (let [m (mouth)]
{:outer (condition/contours params (:outer m))
:inner (condition/contours params (:inner m))
:aperture (:aperture m)})
:eye {:eyes (condition-eyes/apply-defaults params (eyes))}
:brow {:brows (condition-brows/apply-defaults
params
(brows/measure params {:dense dense :transforms transforms})
(eyes))}
:teeth (let [aperture (:aperture (mouth))]
{:teeth (condition-interior/apply-defaults
params
(mapv interior/head-local interior transforms
(repeat aspect))
aperture)})
(throw (ex-info "unknown measured feature type" {:area area}))))))
(defn subjects
"Per-subject source landmarks -> per-subject conditioned measurements.
Every tracked face in one shot goes through the same measurement path and is
conditioned on its OWN anchor fit, because the fit maps a face onto its own
mean pose: sharing one would register the second face against the first one's
head. What they share is the video, and that is already expressed by them
sharing the analysis record."
[params by-subject]
(into {} (map (fn [[id inputs]] [id (measure params inputs)])) by-subject))
(defn build
"`by-subject` is subject id -> that face's source tracks, one entry per
tracked face."
[params by-subject]
(freeze/clip params (subjects params by-subject)))
[params inputs]
(freeze/clip params (measure params inputs)))
(defn footage
"A real manifest and its detected landmarks through the same measurement and
freeze path as the synthetic take. The source cadence stays in :fps; picture
sampling is a root time map applied only after this artifact exists."
[manifest {:keys [dimensions detector subjects]}]
[manifest {:keys [dense detected dimensions interior presence detector]}]
(let [[w h] dimensions
params (merge knobs
{:name (or (:source manifest) "footage")
:fps (:fps manifest) :aspect (/ w h)
:stage [320 200] :fit-motion? true
:expose 1 :head :free
:expose 1 :head :as-filmed
;; The detector's identity comes from the server, which
;; hashes the model asset it serves rather than trusting a
;; version string somebody has to remember to bump. See
@ -134,4 +82,5 @@
;; these landmarks is the failure this prevents.
:analysis (analysis-for (assoc manifest :width w :height h)
detector)})]
(build params subjects)))
(build params {:dense dense :detected detected :interior interior
:presence presence})))

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

@ -21,23 +21,10 @@
([entry] (install! entry "footage"))
([entry kind]
(let [id (keyword kind (str (swap! serial inc)))]
(when-let [old (:audio @loaded)]
(when (and (not= old (:audio entry)) (.startsWith old "blob:"))
(js/URL.revokeObjectURL old)))
(reset! loaded (assoc entry :id id))
id)))
(defn entry [id]
(if (= id (:id @loaded))
@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."
[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")))))
(get db/clips id)))

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

@ -15,18 +15,30 @@
[re-frame.core :as rf]))
(rf/reg-sub ::clip-id (fn [db _] (:clip/current db)))
(rf/reg-sub ::paint-revision (fn [db _] (:paint/revision db)))
(rf/reg-sub
::clip
:<- [::clip-id]
:<- [::paint-revision]
(fn [[id _] _] (:clip (footage/entry id))))
(fn [id _] (:clip (footage/entry id))))
(rf/reg-sub
::timeline
:<- [::clip]
(fn [clip _] (some-> clip clip/root)))
:<- [::playback/display-fps]
(fn [[clip picture-fps] _]
;; The ROOT timeline, with picture sampling written onto its root node's time
;; map. Only that node's time map changes: the dense source track stays at its
;; native rate and the audio clock still advances through source time.
;;
;; `:fps` is read off the CLIP and `:frames` off the timeline, which is the
;; whole reason the two came apart — the source cadence is a fact about how fast
;; the clip plays against its audio, and a nested timeline will not have one.
(when-let [tl (clip/root clip)]
(if (and picture-fps (< picture-fps (:fps clip)))
(-> tl
(assoc-in [:nodes :root :time :source-fps] (:fps clip))
(assoc-in [:nodes :root :time :sample-fps] picture-fps))
tl))))
(rf/reg-sub
::exposure
@ -67,12 +79,8 @@
(rf/reg-sub
::resolver
:<- [::clip]
:<- [::timeline]
:<- [::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 [[tl store palette] _]
(when tl (timeline/resolver tl store palette))))

149
frontend/src/arthur/ui/paint.cljs
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]))}])])]))

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

@ -151,14 +151,7 @@
(js/performance.mark "arthur/blit:start")
(canvas/blit! canvas ras ramp))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
(js/performance.measure "arthur/paint" "arthur/paint:start")
;; User Timing entries otherwise accumulate forever in the browser's
;; performance timeline during playback. DevTools captures the events as
;; they happen; keeping copies on the page serves no purpose.
(js/performance.clearMarks "arthur/paint:start")
(js/performance.clearMarks "arthur/blit:start")
(js/performance.clearMeasures "arthur/resolve+draw")
(js/performance.clearMeasures "arthur/paint"))))
(js/performance.measure "arthur/paint" "arthur/paint:start"))))
(defonce ^:private watch
;; A scene swap changes the resolver and not the frame number, so the loop

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

@ -7,97 +7,15 @@
why scrubbing at speed does not re-render the page."
(: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.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]))
[re-frame.core :as rf]))
(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]))])]))
(defn- audio []
(let [src @(rf/subscribe [::sub/audio])]
@ -154,8 +72,6 @@
;; 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]
@ -217,61 +133,6 @@
(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
@ -279,22 +140,17 @@
;; 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]]))
[:canvas.stage
{:ref #(player/set-canvas! %)
:width w :height h
:style {:width (str (* zoom w) "px") :height (str (* zoom h) "px")}}]))
(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."]])

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

@ -21,25 +21,6 @@
(is (= [:a :a :a :a :b :b :b :b :b :b :b :b :c :c]
(mapv #(ch/value-at c %) (range 0 14))))))
(deftest linear-vector-keys-interpolate-each-component
(let [c (ch/keyed {0 [0.4 0.6], 10 [0.6 0.4]} :linear)
frames [0 5 10 5 2]
cursor (ch/cursor c)]
(is (empty? (ch/problems c)))
(is (= [0.5 0.5] (ch/value-at c 5)))
(is (= (mapv #(ch/value-at c %) frames)
(mapv #(ch/sample! cursor %) frames)))))
(deftest one-channel-can-cut-then-tween
(let [c (assoc (ch/keyed {0 [0 0], 4 [4 0], 8 [8 0]})
:segments {4 :linear})
cursor (ch/cursor c)]
(is (= [0 0] (ch/value-at c 2)))
(is (= [4 0] (ch/value-at c 4)))
(is (= [6 0] (ch/value-at c 6)))
(is (= (mapv #(ch/value-at c %) [0 2 4 6 8 3 7])
(mapv #(ch/sample! cursor %) [0 2 4 6 8 3 7])))))
(deftest a-frame-before-the-first-key-reads-the-first-key
;; The JS activeKey clamps low, and that is kept: a channel's first key is the
;; pose the part starts in. Having NO value is a different question — it is a
@ -241,18 +222,8 @@
(is (seq (ch/problems {:animated? true :keys {0 1}
:dense {:store "x" :offset 0 :stride 1 :frames 1}}))
"one shape at a time")
(is (empty? (ch/problems (ch/keyed {0 0.0, 10 1.0} :linear)))
"scalar controls can interpolate")
(is (seq (ch/problems (ch/keyed {0 :a, 10 :b} :linear)))
"a cut or tone cannot interpolate"))
(deftest numeric-channels-can-ramp-between-keys
(let [c (ch/keyed {0 0.0, 10 1.0} :linear)
cursor (ch/cursor c)]
(is (= [0.0 0.5 1.0 1.0]
(mapv #(ch/value-at c %) [0 5 10 15])))
(is (= [0.0 0.5 1.0 0.2]
(mapv #(ch/sample! cursor %) [0 5 10 2])))))
(is (seq (ch/problems {:animated? true :interp :linear :keys {0 1}}))
"only :hold is implemented"))
(deftest component-reads-vectors-and-typed-arrays-the-same-way
(is (= 3 (ch/component [3 4] 0)))

50
frontend/test/arthur/domain/crc32_test.cljs
View file

@ -1,50 +0,0 @@
(ns arthur.domain.crc32-test
"CRC-32 against PUBLISHED vectors, and not against itself.
The failure this guards is the quiet one. A wrong polynomial, a table built
with the bits the unreflected way round, a missing final complement — each of
them produces a checksum that is stable, self-consistent, and rejected by every
PNG and ZIP reader on earth as \"this file is corrupt\". Nothing inside this
codebase can notice that, because both sides of every internal comparison would
be wrong together. So the expectations below are the standard's own values —
`0xcbf43926` for \"123456789\" is the check value printed in the CRC-32 spec —
cross-checked here against node's `zlib.crc32`."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.crc32 :as crc32]))
(defn- ascii [^String s]
(let [out (js/Uint8Array. (.-length s))]
(dotimes [i (.-length s)] (aset out i (.charCodeAt s i)))
out))
(deftest known-vectors
;; The published check values. If any of these moves, the table is wrong and
;; every PNG and zip this tool writes is unreadable.
(doseq [[s expected] {"" 0x00000000
"a" 0xe8b7be43
"123456789" 0xcbf43926
"The quick brown fox jumps over the lazy dog" 0x414fa339}]
(is (= expected (crc32/of (ascii s)))
(str (pr-str s) " -> 0x"
(.padStart (.toString (crc32/of (ascii s)) 16) 8 "0")))))
(deftest it-is-unsigned
;; The field is a u32 in both formats, and ClojureScript's bit ops are signed.
;; A CRC whose top bit is set must not arrive here negative, or `u32!` writes
;; the two's-complement bytes of a negative number into the header.
(let [high (filter #(>= (crc32/of (ascii (str %))) 0x80000000) (range 512))]
(is (seq high) "no high-bit CRC in the sample, so this asserts nothing")
(doseq [n (take 8 high)]
(is (<= 0 (crc32/of (ascii (str n))) 0xffffffff)))))
(deftest the-range-arity-reads-only-the-range
;; PNG chunks rely on this: the CRC covers the type and payload but NOT the
;; leading length, so `of` has to be able to start partway in.
(let [whole (ascii "..123456789..")]
(is (= 0xcbf43926 (crc32/of whole 2 11))))
(testing "and agrees with a copy of the same bytes"
(let [whole (ascii "xx123456789")]
(is (= (crc32/of (ascii "123456789")) (crc32/of whole 2 11))))))
(deftest an-empty-range-is-the-empty-crc
(is (= 0 (crc32/of (ascii "abc") 1 1))))

11
frontend/test/arthur/domain/feature_test.cljs
View file

@ -1,5 +1,6 @@
(ns arthur.domain.feature-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.clip :as clip]
[arthur.domain.feature :as feature]
[arthur.domain.params :as params]))
@ -11,22 +12,16 @@
{: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))
: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]
[id {:id id :frames 1
:nodes {:head {:id :head :kind :group :z "a1"
:measured {[:xform :rot]
{:animated? false :value 0.0}}}}}]))
people)}))
:timelines {:main {:id :main :frames 1 :nodes {}}}}))
(defn- problems [c]
(feature/problems c))
(feature/problems c (clip/nodes c)))
(deftest five-people-can-have-nine-identified-eyes
(let [scene (nine-eyes)]

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

@ -40,17 +40,16 @@
(is (contains? ls "clip/c7/timeline/main"))
(is (= {:frames 229} (get ls "clip/c7/timeline/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/feature/face-1~eye-r"))
(is (contains? ls "clip/c7/group/face-1~eyes"))
(is (contains? ls "clip/c7/timeline/main/node/mouth"))
(is (contains? ls "clip/c7/timeline/main/channel/mouth/geom.pts"))
(is (contains? ls "clip/c7/timeline/main/channel/mouth-in/vis"))
(is (contains? ls "clip/c7/feature/eye-r"))
(is (contains? ls "clip/c7/group/eyes-1"))
(is (contains? ls "clip/c7/subject/face-1"))
;; A head's measured channels are written together by a freeze and replaced
;; `: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/timeline/main/measured/head"))
(is (= 3 (count (get ls "clip/c7/timeline/main/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 +59,10 @@
;; 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")]
(is (= {:id :mouth :name "mouth" :kind :poly :parent :head
:z "a1" :pose-group :mouth} n))
n (get ls "clip/c1/timeline/main/node/mouth")]
(is (= {:id :mouth :name "mouth" :kind :poly :parent :head :z "a1"} n))
(is (nil? (:channels n)))
(is (:animated? (get ls "clip/c1/timeline/face-1/channel/mouth/geom.pts")))))
(is (:animated? (get ls "clip/c1/timeline/main/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
@ -101,36 +99,6 @@
(is (thrown-with-msg? ExceptionInfo #"cannot contain ~"
(leaf/segment (keyword "a~b")))))
(deftest a-placement-id-is-a-uuid-and-comes-back-one
;; A symbol instance is keyed by a uuid — `demo/stage/compose` has the argument
;; for why — and a leaf path is text, so reading one back has to return the id it
;; named and not a keyword that merely prints the same. A placement keyed
;; `:8f594d72-...` instead of `#uuid "8f594d72-..."` is a document that looks
;; 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
:z "a1" :name "8625 bottom left"}})
ls (leaf/leaves :c1 c)]
(is (contains? ls (str "clip/c1/timeline/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])))))))
(deftest only-a-whole-canonical-uuid-reads-as-one
;; The id encoding decides by SHAPE, so the boundaries of that shape are the
;; whole of the rule: an id that merely CONTAINS a uuid, or is one character off,
;; or is upper-case, is an ordinary keyword and has to stay one.
(testing "these are uuids"
(is (uuid? (leaf/unsegment "8f594d72-a97f-4a32-82fd-08d1670a2218"))))
(testing "and these are not"
(doseq [s ["face-8f594d72-a97f-4a32-82fd-08d1670a2218"
"8f594d72-a97f-4a32-82fd-08d1670a2218-left"
"8f594d72-a97f-4a32-82fd-08d1670a221"
"8F594D72-A97F-4A32-82FD-08D1670A2218"
"not-a-uuid" "main"]]
(is (keyword? (leaf/unsegment s)) (str s " must stay a keyword")))))
(deftest another-clips-leaves-are-ignored-rather-than-merged
;; A project's whole leaf map can be handed in for one clip, which is what makes
;; a two-clip project one fetch.
@ -155,7 +123,7 @@
(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/timeline/main/node/mouth")]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-node-leaf-is-scoped-to-its-own-timeline
@ -167,7 +135,7 @@
(assoc "clip/c1/timeline/sym~blink" {:frames 3}
"clip/c1/timeline/sym~blink/node/mouth"
{:id :mouth :kind :poly :parent nil :z "a1"})
(dissoc "clip/c1/timeline/face-1/node/mouth"))]
(dissoc "clip/c1/timeline/main/node/mouth"))]
(is (some #(re-find #"node with no node leaf" %) (leaf/problems ls)))))
(deftest a-property-with-path-punctuation-in-it-is-refused

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

@ -1,32 +0,0 @@
(ns arthur.domain.paint-test
(:require [cljs.test :refer [deftest is]]
[arthur.demo :as demo]
[arthur.domain.channel :as channel]
[arthur.domain.leaf :as leaf]
[arthur.domain.paint :as paint]
[arthur.domain.timeline :as timeline]))
(defn- geometry [clip]
(get-in clip [:timelines :main :nodes :paint-test :channels paint/geometry]))
(deftest drawing-keys-hold-and-tween-on-the-timeline-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])
held (geometry c4)
mixed-clip (paint/set-segment-interp c4 :paint-test 9 :linear)
mixed (geometry mixed-clip)]
(is (= [3 229] (get-in c2 [:timelines :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))))
(is (= 10 (first (channel/value-at mixed 6))) "the first gap cuts")
(is (= 28 (first (channel/value-at mixed 12))) "the second gap tweens")
(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)))
(is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip))))))

227
frontend/test/arthur/domain/png_test.cljs
View file

@ -1,227 +0,0 @@
(ns arthur.domain.png-test
"The encoder, asserted by DECODING what it wrote.
This file reads the bytes back — chunk framing, CRCs, inflate, un-filter — and
compares the recovered pixels against the ramp expansion they are supposed to
be. Anything weaker would not be worth writing. The claim `domain/png` makes is
bit-exactness: the file holds the bytes `raster/draw-ops!` produced, expanded
through the ramp at an integer zoom, with nothing resampling or smoothing on the
way. A test that only checked the header would pass on a file whose every pixel
was wrong, and a test that only checked it parses would pass on one the encoder
and this test agreed to get wrong together. So the inflate here is node's own
`DecompressionStream` and the un-filter is written out longhand from the spec.
It is also the test that catches the encoder not running at all. The first
version of `deflate!` piped a `Blob` instead of the Blob's `.stream`, so every
export died at the first frame with `pipeThrough is not a function` — reachable
only by encoding something, which nothing under node did until this file."
(:require [cljs.test :refer [deftest is testing async]]
[arthur.domain.crc32 :as crc32]
[arthur.domain.png :as png]
[arthur.domain.raster :as raster]))
;; A ramp with no two entries alike, so a pixel that lands on the wrong index
;; cannot pass by holding a colour that happens to match its neighbour's.
(def ^:private ramp
(mapv (fn [i] [(* 10 i) (+ 1 (* 10 i)) (+ 2 (* 10 i))]) (range 16)))
(defn- chunks
"The file's chunks as [{:type :data :crc :crc-ok?}], after the signature."
[^js b]
(let [u32 (fn [at] (-> (+ (bit-shift-left (aget b at) 24)
(bit-shift-left (aget b (+ at 1)) 16)
(bit-shift-left (aget b (+ at 2)) 8)
(aget b (+ at 3)))
(unsigned-bit-shift-right 0)))]
(loop [at 8 acc []]
(if (>= at (.-length b))
acc
(let [n (u32 at)
tag (apply str (map #(char (aget b (+ at 4 %))) (range 4)))
data (.subarray b (+ at 8) (+ at 8 n))
crc (u32 (+ at 8 n))]
(recur (+ at 12 n)
(conj acc {:type tag :data data :crc crc
;; Over the TYPE and payload, not the length — which
;; is the detail a hand-rolled chunk writer gets wrong.
:crc-ok? (= crc (crc32/of b (+ at 4) (+ at 8 n)))})))))))
(defn- inflate!
[^js bytes]
(-> (js/Response. (.pipeThrough (.stream (js/Blob. #js [bytes]))
(js/DecompressionStream. "deflate")))
(.arrayBuffer)
(.then #(js/Uint8Array. %))))
(defn- unfilter
"Undo the per-row filters of an inflated PNG. Returns the rows as vectors of
bytes. Only filter 0 (None) and 2 (Up) are handled; anything else is a bug in
the encoder rather than something to be lenient about, so it throws."
[^js raw w h]
(let [stride (* w 3)]
(loop [y 0 prev (vec (repeat stride 0)) acc []]
(if (= y h)
acc
(let [at (* y (inc stride))
f (aget raw at)
_ (when-not (#{0 2} f)
(throw (ex-info "unexpected PNG filter type" {:row y :filter f})))
row (mapv (fn [i]
(let [s (aget raw (+ at 1 i))]
(bit-and (if (= f 2) (+ s (nth prev i)) s) 0xff)))
(range stride))]
(recur (inc y) row (conj acc row)))))))
(defn- decoded
"Promise of {:w :h :rows}, the encoder's output read back as RGB rows."
[^js file w h zoom]
(let [cs (chunks file)
ihdr (:data (first (filter #(= "IHDR" (:type %)) cs)))
idat (:data (first (filter #(= "IDAT" (:type %)) cs)))]
(-> (inflate! idat)
(.then (fn [raw]
{:chunks cs
:ihdr ihdr
:rows (unfilter raw (* w zoom) (* h zoom))})))))
(defn- try!
"Call `f`, turning a SYNCHRONOUS throw into a rejected promise.
`png/encoder`'s returned function does the whole of its pixel work before it
returns a promise, so a failure in there throws rather than rejecting, and an
uncaught throw out of a `deftest` body aborts the entire node suite at this
namespace — which is how the `pipeThrough` bug presented: 250 unrelated tests
stopped reporting. Routing it through a rejection keeps the blast radius to the
one test and leaves the `.catch` below as the single place failures land."
[f]
(try (js/Promise.resolve (f))
(catch :default e (js/Promise.reject e))))
(defn- ras
"A small raster whose indices are all different from each other, so a
transposed or off-by-one read cannot look right."
[w h]
(let [r (raster/make w h)]
(dotimes [y h]
(dotimes [x w]
(aset (:buf r) (+ (* y w) x) (mod (+ 1 x (* 3 y)) 16))))
r))
(deftest the-file-is-a-png
(async done
(let [r (ras 4 3)]
(-> (try! #((png/encoder 4 3 1) r ramp))
(.then (fn [file]
(testing "signature"
(is (= [0x89 0x50 0x4e 0x47 0x0d 0x0a 0x1a 0x0a]
(mapv #(aget file %) (range 8)))))
(let [cs (chunks file)]
(testing "chunk order: IHDR first, IEND last, one IDAT"
(is (= ["IHDR" "IDAT" "IEND"] (mapv :type cs))))
(testing "every chunk's CRC covers type and payload"
(doseq [c cs]
(is (:crc-ok? c) (str (:type c) " CRC")))))
(done)))
(.catch (fn [e] (is false (str "encode threw: " e)) (done)))))))
(deftest the-ihdr-declares-truecolour-at-the-zoomed-size
(async done
(-> (-> (try! #((png/encoder 4 3 3) (ras 4 3) ramp))
(.then #(decoded % 4 3 3)))
(.then (fn [{:keys [ihdr]}]
;; Width and height are the ZOOMED size: the zoom is baked into
;; the file, not left as a flag for a reader to honour.
(is (= 12 (aget ihdr 3)) "width")
(is (= 9 (aget ihdr 7)) "height")
(is (= 8 (aget ihdr 8)) "bit depth")
(is (= 2 (aget ihdr 9)) "colour type 2, truecolour")
(is (= 0 (aget ihdr 10)) "compression: deflate")
(is (= 0 (aget ihdr 11)) "filter method: adaptive")
(is (= 0 (aget ihdr 12)) "no interlace")
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest every-pixel-is-its-ramp-entry
;; The bit-exactness claim, at zoom 1: no filtering, no subsampling, no colour
;; management — the byte in the buffer indexes the ramp and the ramp's RGB is
;; what lands in the file.
(async done
(let [r (ras 5 4)]
(-> (-> (try! #((png/encoder 5 4 1) r ramp))
(.then #(decoded % 5 4 1)))
(.then (fn [{:keys [rows]}]
(is (= 4 (count rows)) "one row per source row")
(doseq [y (range 4) x (range 5)]
(let [want (nth ramp (aget (:buf r) (+ (* y 5) x)))
got [(nth (nth rows y) (* 3 x))
(nth (nth rows y) (+ 1 (* 3 x)))
(nth (nth rows y) (+ 2 (* 3 x)))]]
(is (= want got) (str "pixel " x "," y))))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))
(deftest the-zoom-duplicates-pixels-and-interpolates-nothing
;; The other half of the claim. At zoom 3 each source pixel must be a 3x3 block
;; of the IDENTICAL colour. Any smoothing shows up as a block whose corners
;; differ from its centre, and any colour not in the ramp is interpolation.
(async done
(let [zoom 3 w 5 h 4
r (ras w h)]
(-> (-> (try! #((png/encoder w h zoom) r ramp))
(.then #(decoded % w h zoom)))
(.then (fn [{:keys [rows]}]
(is (= (* h zoom) (count rows)) "one row per zoomed row")
(doseq [y (range h) x (range w)]
(let [want (nth ramp (aget (:buf r) (+ (* y w) x)))
block (for [dy (range zoom) dx (range zoom)]
(let [row (nth rows (+ (* y zoom) dy))
px (* 3 (+ (* x zoom) dx))]
[(nth row px) (nth row (+ px 1)) (nth row (+ px 2))]))]
(is (= #{want} (set block))
(str "the " zoom "x" zoom " block at " x "," y
" should be one colour: " (pr-str (set block))))))
(testing "and no colour outside the ramp appears anywhere"
(let [seen (set (for [row rows x (range (/ (count row) 3))]
[(nth row (* 3 x)) (nth row (+ 1 (* 3 x)))
(nth row (+ 2 (* 3 x)))]))]
(is (empty? (remove (set ramp) seen))
(pr-str (remove (set ramp) seen)))))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))
(deftest a-flat-frame-costs-almost-nothing
;; Why filter Up is chosen, made an assertion rather than a claim in a comment:
;; a single-colour stage at zoom 4 is duplicate scanlines, Up turns all but the
;; first into runs of zeros, and deflate takes those to nearly nothing. If this
;; ratio collapses, the filter or the row order has changed and every export
;; got many times bigger.
(async done
(let [w 64 h 64 zoom 4
flat (raster/clear! (raster/make w h) 7)]
(-> (try! #((png/encoder w h zoom) flat ramp))
(.then (fn [file]
(let [raw (* w zoom h zoom 3)]
(is (< (.-length file) (/ raw 100))
(str (.-length file) " bytes for " raw " raw")))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))
(deftest the-encoder-is-reusable-across-frames
;; The export loop holds ONE encoder and feeds it every frame, because the
;; scratch inside it is megabytes. So the scratch must not leak between frames:
;; encoding a, then b, then a again has to give byte-identical files for the two
;; a's. A `prev` row left dirty from the previous frame fails exactly here.
(async done
(let [enc (png/encoder 5 4 2)
a (ras 5 4)
b (raster/clear! (raster/make 5 4) 9)
hex #(apply str (map (fn [i] (.toString (aget % i) 16)) (range (.-length %))))]
(-> (.then (try! #(enc a ramp))
(fn [first-a]
(-> (try! #(enc b ramp))
(.then (fn [_] (try! #(enc a ramp))))
(.then (fn [second-a]
(is (= (hex first-a) (hex second-a))
"the same raster encoded twice, around another frame")
(done))))))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))

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

@ -26,8 +26,6 @@
[arthur.flow.freeze :as freeze]
[arthur.support.ops :as ops]))
(defn- face-timeline [c] (clip/timeline c :face-1))
(defn- wired
"A clip out and back, over a wire that is really only JSON."
[cid clip]
@ -59,8 +57,8 @@
"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 (clip/root (:clip @before)) (:store @before))
b (g (clip/root (:clip @after)) (:store @after))]
(testing (str label ", " order)
(doseq [frame fs]
(is (= (a frame) (b frame))
@ -84,8 +82,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 (clip/root (:clip locked)) (:store locked))
b (ops/resolved (clip/root (:clip back)) (:store back))]
(is (= (:clip locked) (:clip back)))
(doseq [frame (range 0 take/frames 7)]
(is (= (a frame) (b frame)) (str "frame " frame)))))
@ -106,17 +104,17 @@
(def ^:private gappy
(delay (freeze/clip (assoc take/params :name "gappy")
{:face-1 (assoc @take/measured
:presence
(into {} (map (fn [[id gap]]
[id (mapv #(not (contains? gap %))
(range take/frames))]))
windows))})))
(assoc @take/measured
:presence
(into {} (map (fn [[id gap]]
[id (mapv #(not (contains? gap %))
(range take/frames))]))
windows)))))
(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 (clip/nodes (: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 +145,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))]
((timeline/resolver (clip/root (:clip back)) (:store back)) 12))]
(is (not (contains? drawn :eye-r)))
(is (contains? drawn :eye-l))
(is (contains? drawn :mouth))))

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

@ -109,10 +109,9 @@
(deftest a-three-pixel-pupil-is-three-by-three-at-every-centre
;; A square pupil is only worth having if it is the SAME square every frame:
;; exactly its nominal size at any centre, or it breathes as the gaze moves.
(doseq [[cx cy] [[20 20] [20.5 20.5] [20.49 19.51] [21 20] [20.9 20.1]]
size [2.6 3 3.4]]
(doseq [[cx cy] [[20 20] [20.5 20.5] [20.49 19.51] [21 20] [20.9 20.1]]]
(let [ras (-> (r/make 40 40) (r/clear! 0))]
(r/fill-rect! ras cx cy size 1)
(r/fill-rect! ras cx cy 3 1)
(let [[x0 x1 y0 y1 n] (bbox ras 1)]
(is (= [3 3 9] [(inc (- x1 x0)) (inc (- y1 y0)) n])
(str "centre " cx "," cy " gave " (inc (- x1 x0)) "x" (inc (- y1 y0)) ":" n))))))

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

@ -1,205 +0,0 @@
(ns arthur.domain.symbol-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.pose :as pose]
[arthur.domain.palette :as pal]
[arthur.domain.timeline :as timeline]))
(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)}}}}}})
(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))))))
(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"))))
(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}))))))
(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 [:timelines :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 (: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))))))

6
frontend/test/arthur/domain/timeline_test.cljs
View file

@ -244,7 +244,7 @@
;; ---- discs and rects ----
(deftest disc-and-rect-extents-retain-precision-for-enclosing-instances
(deftest a-discs-radius-takes-the-mean-scale-and-a-rects-size-is-rounded
(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"
@ -253,7 +253,9 @@
: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)))))
;; 1.7 x 2 is 3.4, and a block 3.4px wide would be 3px on one frame and 4 on
;; the next, which reads as the pupil breathing.
(is (= 3 (:size r)))))
;; ---- the fast path and the specification agree ----

164
frontend/test/arthur/domain/zip_test.cljs
View file

@ -1,164 +0,0 @@
(ns arthur.domain.zip-test
"The container, asserted field by field against the format.
Same reasoning as `png-test`: the only reader that matters is someone else's,
so an assertion that the writer agrees with itself is worth nothing. Every
expectation here is a number the ZIP specification fixes — the four signatures,
method 0, the offsets in the central directory, the MS-DOS date encoding — and
the test parses the archive back out of the bytes rather than being handed the
intermediate values.
`archive` takes its timestamp as an argument precisely so this file can exist:
with the clock pinned, the same entries produce the same bytes, and the whole
archive is comparable."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.crc32 :as crc32]
[arthur.domain.zip :as zip]))
(defn- bytes-of [^String s]
(let [out (js/Uint8Array. (.-length s))]
(dotimes [i (.-length s)] (aset out i (.charCodeAt s i)))
out))
(defn- flatten-parts
"The vector of parts `archive` returns, as one buffer — which is what a `Blob`
of them would be on disk, and therefore what a reader sees."
[parts]
(let [n (reduce + (map #(.-length ^js %) parts))
out (js/Uint8Array. n)]
(reduce (fn [at ^js p] (.set out p at) (+ at (.-length p))) 0 parts)
out))
(defn- u16 [^js b at]
(+ (aget b at) (bit-shift-left (aget b (+ at 1)) 8)))
(defn- u32 [^js b at]
(-> (+ (aget b at)
(bit-shift-left (aget b (+ at 1)) 8)
(bit-shift-left (aget b (+ at 2)) 16)
(* 0x1000000 (aget b (+ at 3))))
(js/Math.round)))
(defn- ascii-at [^js b at n]
(apply str (map #(char (aget b (+ at %))) (range n))))
(def ^:private at (js/Date. 2026 8 28 14 30 20)) ; 2026-09-28 14:30:20
(def ^:private entries
[{:name "take/0001.png" :data (bytes-of "first-frame-bytes")}
{:name "take/0002.png" :data (bytes-of "second")}
{:name "take/audio.wav" :data (bytes-of "RIFF....WAVEfmt ")}])
(def ^:private built (delay (flatten-parts (zip/archive entries at))))
(defn- locals
"Every local file header in the archive, parsed, in the order they appear."
[^js b]
(loop [at 0 acc []]
(if (or (>= (+ at 4) (.-length b)) (not= 0x04034b50 (u32 b at)))
acc
(let [n (u16 b 26)
nlen (u16 b (+ at 26))
elen (u16 b (+ at 28))
size (u32 b (+ at 18))]
(recur (+ at 30 nlen elen size)
(conj acc {:offset at
:method (u16 b (+ at 8))
:time (u16 b (+ at 10))
:date (u16 b (+ at 12))
:crc (u32 b (+ at 14))
:csize (u32 b (+ at 18))
:usize (u32 b (+ at 22))
:name (ascii-at b (+ at 30) nlen)
:data (.subarray b (+ at 30 nlen elen)
(+ at 30 nlen elen size))})))))
)
(defn- eocd
"The end-of-central-directory record, which is the last 22 bytes when there is
no archive comment."
[^js b]
(let [at (- (.-length b) 22)]
{:signature (u32 b at)
:entries (u16 b (+ at 8))
:dir-size (u32 b (+ at 12))
:dir-at (u32 b (+ at 16))}))
(deftest the-archive-is-readable-as-a-zip
(let [b (deref built)
e (eocd b)]
(testing "end of central directory"
(is (= 0x06054b50 (:signature e)))
(is (= 3 (:entries e)) "one record per entry"))
(testing "the central directory is where the record says it is"
(is (= 0x02014b50 (u32 b (:dir-at e))))
(is (= (- (.-length b) 22) (+ (:dir-at e) (:dir-size e)))
"directory ends exactly where the EOCD begins"))))
(deftest every-entry-is-stored-verbatim
;; Method 0, and the two size fields equal — the namespace's whole premise is
;; that the payloads are already compressed and must not be touched. A stray
;; deflate here would show up as csize != usize.
(let [ls (locals (deref built))]
(is (= 3 (count ls)))
(doseq [[l entry] (map vector ls entries)]
(is (= 0 (:method l)) (str (:name l) " is stored"))
(is (= (:name entry) (:name l)))
(is (= (.-length (:data entry)) (:usize l)) "uncompressed size")
(is (= (:usize l) (:csize l)) "stored, so the two sizes agree")
(testing "the bytes come back identical"
(is (= (vec (array-seq (:data entry))) (vec (array-seq (:data l)))))))))
(deftest every-crc-is-the-crc-of-the-payload
;; Written into the local header AND the central directory, and an unzip checks
;; both. They have to agree with each other and with the data.
(let [b (deref built)
ls (locals b)
dir-at (:dir-at (eocd b))]
(loop [i 0 at dir-at]
(when (< i (count ls))
(let [nlen (u16 b (+ at 28))
l (nth ls i)]
(is (= (crc32/of (:data (nth entries i))) (:crc l))
(str (:name l) " local CRC"))
(is (= (:crc l) (u32 b (+ at 16)))
(str (:name l) " central CRC matches local"))
(testing "and the directory points at the local header"
(is (= (:offset l) (u32 b (+ at 42)))))
(recur (inc i) (+ at 46 nlen (u16 b (+ at 30)) (u16 b (+ at 32)))))))))
(deftest the-same-entries-and-clock-give-the-same-bytes
;; What makes an export assertable at all, and what `at` is a parameter for.
(is (= (vec (array-seq (flatten-parts (zip/archive entries at))))
(vec (array-seq (flatten-parts (zip/archive entries at)))))))
(deftest the-clock-is-the-only-thing-that-moves
(let [other (js/Date. 2026 8 28 14 30 40)]
(is (not= (vec (array-seq (flatten-parts (zip/archive entries other))))
(vec (array-seq (deref built))))
"a different timestamp must reach the headers")))
(deftest dos-time-is-the-format-s-encoding
;; Year offset from 1980, and seconds in 5 bits so they land on even values.
(let [[date time] (zip/dos-time (js/Date. 2026 8 28 14 30 21))]
(is (= 2026 (+ 1980 (bit-shift-right date 9))) "year")
(is (= 9 (bit-and (bit-shift-right date 5) 0xf)) "month is one-based")
(is (= 28 (bit-and date 0x1f)) "day")
(is (= 14 (bit-shift-right time 11)) "hour")
(is (= 30 (bit-and (bit-shift-right time 5) 0x3f)) "minute")
(is (= 20 (* 2 (bit-and time 0x1f))) "seconds round down to even"))
(testing "a date before 1980 clamps rather than wrapping into a plausible year"
(let [[date _] (zip/dos-time (js/Date. 1970 0 1))]
(is (= 1980 (+ 1980 (bit-shift-right date 9)))))))
(deftest a-non-ascii-name-is-refused
;; Rather than written without the UTF-8 flag and arriving mojibake'd.
(is (thrown? js/Error
(zip/archive [{:name "také/0001.png" :data (bytes-of "x")}] at))))
(deftest an-empty-archive-is-still-a-valid-zip
(let [b (flatten-parts (zip/archive [] at))
e (eocd b)]
(is (= 22 (.-length b)) "just the EOCD")
(is (= 0x06054b50 (:signature e)))
(is (= 0 (:entries e)))))

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

@ -1,91 +0,0 @@
(ns arthur.events.export-test
"The picker's round trip, which is the whole of a bug that read as a hung tab.
An export target is a timeline or a placement inside one. A symbol timeline's id
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
`:do-fx` where nothing catches it: `:busy?` latches on and the readout sits at
\"frame 0 /\" forever with nothing in the status line.
So the pair is asserted directly, on both kinds, because `name` and `keyword`
are individually reasonable-looking and only wrong together."
(:require [cljs.test :refer [deftest is testing]]
[arthur.events.export :as export]))
(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}]]
(let [back (export/target-id (export/target-value t))]
(is (= (:timeline t) (:timeline 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"
(when (:isolate t)
(is (uuid? (:isolate back))))))))
(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 (= (str "n:main:" a-uuid)
(export/target-value {:timeline :main :isolate a-uuid}))))
(deftest a-whole-timeline-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")))))
(deftest the-old-encoding-is-the-bug
;; A guard against someone "simplifying" this back to `name`. `name` is lossy on
;; exactly the ids the stage produces, and this states what that costs.
(is (not= :sym/face-8625 (keyword (name :sym/face-8625)))
"name/keyword loses the namespace, which is what broke the export")
(is (thrown? js/Error (name a-uuid))
"and a placement's id is not something `name` can take at all"))
;; ---- what the picker offers ----
(def ^:private clip
"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
{: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"
: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"
: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"
(is (= [nil nil] (mapv :isolate (take 2 ts))))
(is (every? uuid? (mapv :isolate (drop 2 ts))))
(is (every? #(= :main (:timeline %)) (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"
(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]))
back (export/target-id (export/target-value t))]
(is (= (norm t) (norm back)) (pr-str t)))))

214
frontend/test/arthur/export/frames_test.cljs
View file

@ -1,214 +0,0 @@
(ns arthur.export.frames-test
"The archive a frame-sequence export produces: its manifest, and its determinism.
The sink is driven through the `Exporter` protocol DIRECTLY here rather than
through `export/run!`, because what this namespace decides is separable from the
walk that feeds it: entry names, the zero-padding an NLE's importer looks for,
whether the sound is in the archive, and whether the same frames give the same
bytes. `export-test` covers the walk, with a sink that only records.
The zip is read back with a small local reader rather than the field-by-field
one in `zip-test`. They are asking different questions — that file is about the
container conforming to the format, this one is about the MANIFEST — and a
reader shared between them would have to serve both and would make neither
obvious."
(:require [cljs.test :refer [deftest is testing async]]
[arthur.domain.png :as png]
[arthur.export :as export]
[arthur.export.frames :as frames]
[arthur.domain.raster :as raster]))
(def ^:private ramp
(mapv (fn [i] [(mod (* 37 i) 256) (mod (* 91 i) 256) (mod (* 17 i) 256)]) (range 16)))
(def ^:private at (js/Date. 2026 8 28 14 30 20))
(defn- fake-audio
"Enough of an `AudioBuffer` for `mix/wav-bytes`, which is all this needs.
`AudioBuffer` is a browser type and the rest of the export stack is asserted
under node on purpose, so the seam is the four accessors wav-bytes actually
reaches for."
[frames rate]
(let [data (js/Float32Array. frames)]
(dotimes [i frames] (aset data i (* 0.5 (js/Math.sin (/ i 8)))))
#js {:numberOfChannels 1
:length frames
:sampleRate rate
:getChannelData (fn [_] data)}))
(defn- entries-of
"The archive's entries as [{:name :size}], in order, read out of the local
headers. Names and sizes are all this file asserts on."
[^js b]
(let [u16 (fn [at] (+ (aget b at) (bit-shift-left (aget b (+ at 1)) 8)))
u32 (fn [at] (js/Math.round (+ (aget b at)
(bit-shift-left (aget b (+ at 1)) 8)
(bit-shift-left (aget b (+ at 2)) 16)
(* 0x1000000 (aget b (+ at 3))))))]
(loop [at 0 acc []]
(if (or (> (+ at 30) (.-length b)) (not= 0x04034b50 (u32 at)))
acc
(let [nlen (u16 (+ at 26))
elen (u16 (+ at 28))
size (u32 (+ at 18))
nm (apply str (map #(char (aget b (+ at 30 %))) (range nlen)))]
(recur (+ at 30 nlen elen size)
(conj acc {:name nm :size size
:data (.subarray b (+ at 30 nlen elen)
(+ at 30 nlen elen size))})))))))
(defn- bytes-of-blob
"A `js/Blob`'s bytes. `finish!` hands back a Blob because a download wants one."
[^js blob]
(-> (.arrayBuffer blob) (.then #(js/Uint8Array. %))))
(defn- run-sink!
"Drive `exporter` over `n` frames, painting frame i entirely with index
`(index i)`. Promise of `{:filename :bytes :entries}`.
ONE raster for the whole walk, repainted in place, because that is what
`export/run!` does and what `frame!` has to cope with."
[exporter {:keys [n w h zoom name audio index]}]
(let [ras (raster/make w h)]
(-> (js/Promise.resolve
(export/begin! exporter {:name name :width w :height h :zoom zoom
:fps 24 :frames n :ramp ramp :audio audio}))
(.then (fn [_]
(reduce (fn [chain i]
(.then chain
(fn [_]
(raster/clear! ras (index i))
(js/Promise.resolve (export/frame! exporter i ras)))))
(js/Promise.resolve)
(range n))))
(.then (fn [_] (export/finish! exporter)))
(.then (fn [{:keys [filename blob]}]
(-> (bytes-of-blob blob)
(.then (fn [bytes]
{:filename filename
:bytes bytes
:entries (entries-of bytes)}))))))))
(defn- run-default! [opts]
(run-sink! (frames/exporter at)
(merge {:n 3 :w 8 :h 6 :zoom 1 :name "take" :index identity} opts)))
(deftest the-frames-are-one-based-and-zero-padded
;; What an image-sequence importer looks for: a common stem, a fixed-width
;; counter, one extension. One-based because that is the convention, and padded
;; so nothing sorts 10 before 9.
(async done
(-> (run-default! {:n 3})
(.then (fn [{:keys [filename entries]}]
(is (= "take.zip" filename))
(is (= ["take/0001.png" "take/0002.png" "take/0003.png"]
(mapv :name entries)))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest the-declared-frame-count-sets-the-width-not-the-frames-that-arrive
;; Four digits minimum, more when the count needs them, so a 12000-frame export
;; is 00001..12000 and still sorts. The width comes from the count `begin!` was
;; DECLARED — the one number that arrives from the spec rather than from the
;; walk — so one frame is enough to assert it and 12000 need not be rendered.
(async done
(let [ex (frames/exporter at)
ras (raster/make 4 4)]
(-> (js/Promise.resolve
(export/begin! ex {:name "big" :width 4 :height 4 :zoom 1 :fps 24
:frames 12000 :ramp ramp :audio nil}))
(.then (fn [_] (js/Promise.resolve (export/frame! ex 0 (raster/clear! ras 3)))))
(.then (fn [_] (export/finish! ex)))
(.then (fn [{:keys [blob]}] (bytes-of-blob blob)))
(.then (fn [bytes]
(is (= ["big/00001.png"] (mapv :name (entries-of bytes)))
"a 12000-frame export pads to five digits")
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))
(deftest the-sound-travels-with-the-picture
;; One archive, both tracks — they have to stay in sync all the way to the
;; cutting room, so a WAV entry appears exactly when there is audio.
(async done
(-> (run-default! {:n 2 :audio (fake-audio 2000 48000)})
(.then (fn [{:keys [entries]}]
(is (= ["take/audio.wav" "take/0001.png" "take/0002.png"]
(mapv :name entries)))
(testing "and the WAV is a RIFF header over 16-bit PCM"
(let [w (:data (first entries))]
(is (= "RIFF" (apply str (map #(char (aget w %)) (range 4)))))
(is (= "WAVE" (apply str (map #(char (aget w %)) (range 8 12)))))
;; 2000 mono frames at 16 bits, plus the 44-byte header.
(is (= (+ 44 (* 2000 2)) (:size (first entries))))))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest a-silent-timeline-produces-no-wav
(async done
(-> (run-default! {:n 2 :audio nil})
(.then (fn [{:keys [entries]}]
(is (= ["take/0001.png" "take/0002.png"] (mapv :name entries)))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest each-frame-is-encoded-before-the-raster-moves-on
;; THE HAZARD the protocol documents: the walk hands back the same buffer every
;; frame. A sink that kept the reference and encoded at `finish!` would write
;; the LAST frame N times, and every entry would be a valid PNG of the wrong
;; picture — which no structural check would notice. Three frames painted three
;; different flat colours must give three different payloads.
;;
;; Stronger than "the three differ": each entry is compared against the PNG of
;; the colour that frame was painted, encoded on its own. So frame 2 holding
;; frame 3's picture fails even though both are valid and distinct. (Their
;; LENGTHS are all equal, incidentally — three uniform fills deflate to the
;; same size and differ only in bytes, which is why size is no evidence here.)
(async done
(let [index (fn [i] (+ 3 i))
reference (fn [i]
(let [enc (png/encoder 8 6 1)]
(enc (raster/clear! (raster/make 8 6) (index i)) ramp)))]
(-> (js/Promise.all #js [(run-default! {:n 3 :index index})
(js/Promise.all (into-array (map reference (range 3))))])
(.then (fn [[{:keys [entries]} refs]]
(let [payloads (mapv (fn [e] (vec (array-seq (:data e)))) entries)]
(is (= 3 (count (distinct payloads)))
"three distinct frames, so nothing was encoded late")
(doseq [i (range 3)]
(is (= (vec (array-seq (nth refs i))) (nth payloads i))
(str "entry " (inc i) " holds the picture painted at frame " i))))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))
(deftest the-same-frames-and-clock-give-the-same-archive
;; What `at` is a parameter for, stated as the assertion it exists to enable.
(async done
(-> (js/Promise.all
#js [(run-default! {:n 3 :index (fn [i] (+ 2 i))})
(run-default! {:n 3 :index (fn [i] (+ 2 i))})])
(.then (fn [[a b]]
(is (= (vec (array-seq (:bytes a))) (vec (array-seq (:bytes b))))
"byte for byte")
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest the-zoom-reaches-the-files
;; The sink passes width, height and zoom to the encoder; this is the assertion
;; that it passes the zoom at all rather than dropping it and writing 1:1.
(async done
(-> (js/Promise.all #js [(run-default! {:n 1 :w 8 :h 6 :zoom 1})
(run-default! {:n 1 :w 8 :h 6 :zoom 4})])
(.then (fn [[one four]]
;; The IHDR's width is at a fixed offset: 8 signature + 8 chunk
;; header, then a big-endian u32.
(let [ihdr-w (fn [{:keys [entries]}]
(let [d (:data (first entries))]
(+ (bit-shift-left (aget d 16) 24)
(bit-shift-left (aget d 17) 16)
(bit-shift-left (aget d 18) 8)
(aget d 19))))]
(is (= 8 (ihdr-w one)) "zoom 1")
(is (= 32 (ihdr-w four)) "zoom 4"))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))

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

@ -1,294 +0,0 @@
(ns arthur.export-test
"The frame walk and the arithmetic above the sink.
THE SYNC RULE IS THE POINT OF THIS FILE. `arthur.export` states it twice — in
its own docstring and in `plan`'s comment — because it is the one failure the
export path exists to prevent: a lower picture rate must HOLD each pose across
several frames and never drop frames, so the emitted length always matches the
audio. Decimating instead gives a file that is silently short, whose sound
slides progressively out of sync, and which looks correct in every other
respect. Nothing downstream can detect that, so it is asserted here, at both
levels: `plan` reports poses separately from frames, and `run!` emits every
frame of the frame space whatever the picture rate is.
The sink is a recording fake. What the walk owes a sink is an ordering and a
count, and a fake is the only way to assert on those without also asserting on
PNG bytes — which `export.frames-test` already does."
(:require [cljs.test :refer [deftest is testing async]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.palette :as pal]
[arthur.export :as export]))
(defn- poly [id z pts color]
{:id id :kind :poly :z z
:channels {[:geom :pts] (ch/framed pts) [:style :color] (ch/framed color)}})
(defn- a-timeline
"One authored square under a `:root` group. Picture sampling now applies to
marked generated channels in the shared resolver, leaving this square alone."
[frames]
{:frames frames
:nodes {:root {:id :root :kind :group :z "a1"}
:sq (assoc (poly :sq "a1" [1 1 6 1 6 5] :brow) :parent :root)}})
(defn- a-clip
"A clip with one square on one timeline. The picture is irrelevant here — what
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)}})
(defn- recorder
"An `Exporter` that records the calls rather than encoding anything.
`:rasters` holds the raster OBJECT each frame arrived with, not a copy, so the
reuse contract can be asserted by identity."
[log]
(reify export/Exporter
(begin! [_ spec] (swap! log assoc :spec spec :frames []) nil)
(frame! [_ i ras]
(swap! log update :frames conj {:i i :index (aget (:buf ras) 0)})
(swap! log update :rasters (fnil conj []) ras)
nil)
(finish! [_] (js/Promise.resolve {:filename "t.zip" :blob :a-blob}))))
(defn- run!*
"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 {}
:palette pal/index-of :ramp pal/rgb :zoom 1
:name "t"}
opts)
(recorder log)
(fn [done total] (swap! log update :progress (fnil conj []) [done total])))
(.then (fn [result] (assoc @log :result result))))))
;; ---- 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})]
(is (= 48 (:frames p)))
(is (= 24 (:fps p)))
(is (= 3 (:zoom p)))
(is (= 960 (:width p)) "the zoom is in the reported size")
(is (= 600 (:height p)))
(is (= 2 (:seconds p)))))
(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 %}))]
(is (= 2 (zoom-of 2.7)) "truncated, not rounded")
(is (= 1 (zoom-of 0)))
(is (= 1 (zoom-of -4)))
(is (= 1 (zoom-of nil)) "an absent zoom is 1:1")
(is (= 1 (zoom-of 1.9)))))
(deftest a-lower-picture-rate-changes-the-poses-and-not-the-length
;; THE SYNC RULE, in the arithmetic. 48 frames at 24fps is two seconds; at a
;; 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
: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
: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}))))
;; ---- the walk ----
(deftest every-frame-is-emitted-once-and-in-order
(async done
(-> (run!* (a-clip {:frames 7}))
(.then (fn [{:keys [frames spec]}]
(is (= (range 7) (map :i frames)) "0..6, in order, no gaps")
(is (= 7 (:frames spec)) "and the sink was told how many to expect")
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest a-lower-picture-rate-still-emits-every-frame
;; THE SYNC RULE, in the walk — the assertion that matters most in this file.
;; The poses repeat; the frames do not thin out.
(async done
(-> (run!* (a-clip {:frames 12 :fps 24}) :picture-fps 8)
(.then (fn [{:keys [frames spec]}]
(is (= 12 (count frames))
"a 12-frame timeline exports 12 frames at any picture rate")
(is (= (range 12) (map :i frames)))
(is (= 24 (:fps spec))
"and the file's rate is the CLIP's, not the picture rate")
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest the-spec-carries-the-unzoomed-stage-and-the-zoom
;; The sink multiplies; it is not handed a pre-multiplied size. `frames/exporter`
;; passes all three to `png/encoder`, which is where the zoom is applied.
(async done
(-> (run!* (a-clip {:w 320 :h 200}) :zoom 4)
(.then (fn [{:keys [spec]}]
(is (= 320 (:width spec)) "stage width, before zoom")
(is (= 200 (:height spec)))
(is (= 4 (:zoom spec)))
(is (= "t" (:name spec)))
(is (= pal/rgb (:ramp spec)))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest progress-counts-completed-frames-against-the-total
;; `[done total]`, one-based on done, so a readout can say "3 of 7" and reach
;; "7 of 7" at the end rather than stopping at 6.
(async done
(-> (run!* (a-clip {:frames 5}))
(.then (fn [{:keys [progress]}]
(is (= [[1 5] [2 5] [3 5] [4 5] [5 5]] progress))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest the-raster-is-one-reused-buffer
;; The protocol documents this and `frames/exporter` depends on knowing it: the
;; walk hands back the SAME raster every frame. If this ever stops being true
;; the contract has loosened and the warnings about encoding late are stale.
(async done
(-> (run!* (a-clip {:frames 4}))
(.then (fn [{:keys [rasters]}]
(is (= 4 (count rasters)))
(is (apply = (map :buf rasters))
"every frame arrived in the same buffer")
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest the-result-is-the-sink-s
;; `run!` returns what `finish!` produced, untouched — the walk does not decide
;; what the artefact is called.
(async done
(-> (run!* (a-clip {:frames 2}))
(.then (fn [{:keys [result]}]
(is (= {:filename "t.zip" :blob :a-blob} result))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest exporting-a-timeline-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 {}
: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))))))
(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)
(.then (fn [{:keys [frames spec]}]
(is (= 4 (count frames)) "the symbol's four frames, not the clip's 30")
(is (= 4 (:frames spec)))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))
;; ---- isolating one placement ----
(def ^:private p1 #uuid "11111111-1111-4111-8111-111111111111")
(def ^:private p2 #uuid "22222222-2222-4222-8222-222222222222")
(def ^:private v1 #uuid "aaaaaaaa-1111-4111-8111-aaaaaaaaaaaa")
(defn- staged
"A stage: two placements of one symbol under a root, and a loose rect that
belongs to neither.
`:voice?` adds an audio track linked to the first placement. It is OFF by
default because a placed track sends `mix/buffer!` to fetch its footage, which
under node is a failed URL parse rather than a mix — so the walk is driven over
a silent stage, and the audio's isolation is asserted on `isolate` itself, where
it needs no clock."
[& {:keys [voice?]}]
{:name "stage" :fps 30 :width 8 :height 6
:timelines
{clip/root-id
{:frames 12
:nodes (cond-> {:root {:id :root :kind :group :z "a1"}
p1 {:id p1 :kind :symbol :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"
: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)}})
(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))))]
(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")
(testing "and nothing else"
(is (not (contains? kept p2)) "the sibling placement goes")
(is (not (contains? kept :loose)) "and so does everything unrelated")
(is (= #{:root p1 v1} kept)))))
(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))))]
(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)))
(testing "and so does isolating a node that is not there"
(is (= tl (export/isolate tl (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})))
"the drawing's own frame space is its own")
(is (= 30 (:fps (export/plan {:clip c :timeline clip/root-id :isolate p1}))))))
(deftest an-isolated-walk-emits-the-stage-s-frames
(async done
(-> (run!* (staged) :isolate p1)
(.then (fn [{:keys [frames spec]}]
(is (= 12 (count frames)) "the stage's twelve, not the symbol's six")
(is (= (range 12) (map :i frames)))
(is (= 12 (:frames spec)))
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done))))))
(deftest an-isolated-export-draws-less-than-the-whole-stage
;; The observable consequence, on the pixels: with one of two placements removed
;; the stage cannot be drawing the same picture. Asserted as a count of non-bg
;; pixels rather than as an image, which is what `domain/raster` is for.
(async done
(let [painted (fn [{:keys [rasters]}]
;; every frame arrives in the same buffer, so this is the last
;; frame's count; it only has to differ, not to be a number.
(count (remove zero? (array-seq (:buf (last rasters))))))]
(-> (js/Promise.all #js [(run!* (staged))
(run!* (staged) :isolate p1)])
(.then (fn [[whole one]]
(is (pos? (painted whole)) "the whole stage draws something")
(is (< (painted one) (painted whole))
"and one placement alone draws strictly less")
(done)))
(.catch (fn [e] (is false (str "threw: " e)) (done)))))))

11
frontend/test/arthur/flow/address_test.cljs
View file

@ -36,7 +36,7 @@
(defn- params-at [overrides]
(merge take/knobs
{:name "addr" :fps fps :aspect 1 :stage [320 200]
:expose 1 :head :free}
:expose 1 :head :as-filmed}
overrides))
(defn- freeze-at
@ -50,7 +50,7 @@
:seed 3 :frames frames :fps (:fps p)
:aspect (:aspect p)}
(:detector overrides))))]
(freeze/clip p {:face-1 (take/measure p {:dense @dense-track})})))
(freeze/clip p (take/measure p {:dense @dense-track}))))
(defn- bytes-of [{:keys [data state]}]
(str (sha/of-bytes (js/Uint8Array. (.-buffer data)))
@ -228,10 +228,9 @@
(assoc (params-at {}) :analysis
(address/analysis {:detector "synth" :version "mulberry32"
:seed 3 :frames frames :fps fps :aspect 1}))
{:face-1 (assoc (take/measure (params-at {}) {:dense @dense-track})
:presence
{:brow-r (mapv #(not (contains? gap %))
(range frames))})}))]
(assoc (take/measure (params-at {}) {:dense @dense-track})
:presence {:brow-r (mapv #(not (contains? gap %))
(range frames))})))]
(is (not= (:key (get @base "brows")) (:key (get with "brows"))))
(is (not= (:key (get @base "brow-pos")) (:key (get with "brow-pos"))))
(doseq [role ["geom" "eyes" "iris-pos" "head-pos" "head-rot" "head-scale"]]

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

@ -48,18 +48,18 @@
(let [presence (ingest/feature-presence take/frames {:eye-r [[10 14]]})
{:keys [clip store]} (flow-take/build
(assoc take/params :aspect 1 :name "observed-gap")
{:face-1 {:dense @take/analysis :presence presence}})
{: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 (clip/nodes clip) [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])))
(is (= [:eye-r :eye-l] (get-in clip [:groups :eyes-1 :members])))
(doseq [f (range 9 14)]
(is (ch/nothing? (sample :eye-r f)))
(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))]
((timeline/resolver (clip/root clip) store pal/index-of) 11))]
(is (not (contains? drawn :eye-r)))
(is (not (contains? drawn :iris-r)))
(is (contains? drawn :eye-l))

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

@ -13,7 +13,6 @@
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.geom :as geom]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.raster :as raster]
@ -30,14 +29,13 @@
;; that has to be right.
(def frozen (delay @take/frozen))
(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*)))
;; The ROOT TIMELINE, which is what an evaluator takes. `clip*` is the document —
;; `:fps`, the stage, the analysis, the tracking identities — and `tl*` is the bag
;; of nodes in its frame space. `timeline/resolver` refuses the wrong one loudly.
(def tl* (delay (clip/root @clip*)))
(def store (delay (:store @frozen)))
(defn- node [id] (get (nodes @clip*) id))
(defn- node [id] (get-in @tl* [:nodes id]))
(defn- chan [id path] (get-in (node id) [:channels path]))
(defn- block-of
@ -58,11 +56,12 @@
(defn- render
"One frame of a CLIP into a byte buffer. The stage's size comes off the clip and
the ops from the complete clip, including nested face timelines."
the ops off its root timeline, because project dimensions are the project's and
not the footage's — and not a timeline's either."
[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 (ops-at (clip/root c) f))
(vec (array-seq (:buf r)))))
(defn- drawn
@ -78,19 +77,23 @@
;; before the data is trusted — which is what it is for. It checks the clip's
;; fields, every timeline in it and the tracking identities, so it is the whole
;; of what a save would refuse.
(doseq [spec [{:mode :free} {:mode :anchored :anchors {0 0}}]]
(let [c (freeze/head-mode spec @frozen)]
(is (empty? (clip/problems c)) (str spec ": " (pr-str (clip/problems c))))))
(let [c (freeze/head-mode {:mode :anchored
:anchors {0 12, 40 88, 150 150}} @frozen)]
(doseq [mode [:as-filmed :locked]]
(let [c (freeze/head-mode {:mode mode} @frozen)]
(is (empty? (clip/problems c)) (str mode ": " (pr-str (clip/problems c))))))
(let [c (freeze/head-mode {:mode :per-plate :kept #{0 12 40 88 150}} @frozen)]
(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)))
;; :face is AUTHORED and :head is MEASURED, and they are two nodes because two
;; different things want that transform. A group node is free; keeping the
;; hand-placed and the measured transform apart is the whole reason the
;; transform is decomposed in the first place.
(is (= [:face :root] (timeline/lineage (:nodes @tl*) :face)))
(is (= [:head :face :root] (timeline/lineage (:nodes @tl*) :head)))
(is (= [:mouth :head :face :root] (timeline/lineage (:nodes @tl*) :mouth)))
(is (= [:mouth-in :mouth :head :face :root]
(timeline/lineage (:nodes @tl*) :mouth-in)))
;; Exposure lives on the clip root and inherits strictly.
(is (= {:mode :map :expose 2} (:time (node :root))))
(is (every? #(nil? (:time (node %))) [:face :head :mouth :mouth-in])))
@ -153,9 +156,8 @@
(is (thrown-with-msg?
ExceptionInfo #"does not fit the block's fixed point"
(freeze/clip (assoc take/params :name "huge")
{:face-1 (update @take/measured :outer
(fn [rings]
(mapv (fn [r] (mapv #(update % :x + 3) r)) rings)))}))))
(update @take/measured :outer
(fn [rings] (mapv (fn [r] (mapv #(update % :x + 3) r)) rings)))))))
;; ---------------------------------------------------------------------------
;; the anchor: three channels, and the inverse
@ -194,15 +196,15 @@
;; of the two says it is. A test that recomputed the chain would only be
;; 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)
(let [c (freeze/head-mode {:mode :as-filmed} @frozen)
res (timeline/resolver (clip/root c) @store pal/index-of)
k (first (:value (chan :face [:xform :scale])))
anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos]))
tfs (:transforms @take/measured)]
(doseq [f (range 0 take/frames 13)]
(let [ops (res f)
op (first (filter #(= [:face-1 :mouth] (:node %)) ops))
op (first (filter #(= :mouth (:node %)) ops))
;; EXPOSURE FIRST. The clip root is on 2s and exposure inherits
;; strictly, so frame 13 shows frame 12's pose — which is also the
;; cheapest place to assert that the grid is actually being applied,
@ -232,69 +234,67 @@
"], the composition says [" wx " " wy "]"))))))
;; ---------------------------------------------------------------------------
;; one dense measurement, with optional held anchor frames
;; the three modes are the three channel shapes
(deftest head-anchors-select-measured-frames-without-copying-channels
(let [free (freeze/head-mode {:mode :free} @frozen)
one (freeze/head-mode {:mode :anchored :anchors {0 12}} @frozen)
keyed (freeze/head-mode {:mode :anchored
:anchors {0 12, 40 88, 150 150}} @frozen)
of (fn [c path] (get-in (nodes c) [:head :channels path]))]
(doseq [c [free one keyed]
path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :dense (ch/describe (of c path))))
(is (= (of free path) (of c path)) "anchor edits do not copy measurements"))
(is (nil? (get-in (nodes free) [:head :anchors])))
(is (= {0 12} (get-in (nodes one) [:head :anchors])))
(is (= {0 12, 40 88, 150 150}
(get-in (nodes keyed) [:head :anchors])))
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
"anchor source addresses survive the document round trip")))
(deftest head-anchor-keys-hold-the-whole-measured-transform
(let [free (timeline/resolver (face-timeline
(freeze/head-mode {:mode :free} @frozen))
@store pal/index-of)
held (timeline/resolver (face-timeline
(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))))]
(is (= (world free 12) (world held 0)))
(is (= (world free 12) (world held 38)))
(is (= (world free 88) (world held 40)))
(is (= (world free 88) (world held 100)))))
(deftest the-three-head-modes-are-the-three-channel-shapes
(let [kept #{0 12 40 88 150}
of (fn [c path] (get-in (clip/nodes c) [:head :channels path]))]
(testing "locked is framed identity"
(let [sc (freeze/head-mode {:mode :locked} @frozen)]
(is (= [:framed :framed :framed]
(mapv #(ch/describe (of sc %))
[[:xform :pos] [:xform :rot] [:xform :scale]])))
(is (= [0.0 0.0] (:value (of sc [:xform :pos]))))
(is (= 0.0 (:value (of sc [:xform :rot]))))
(is (= [1.0 1.0] (:value (of sc [:xform :scale]))))))
(testing "as filmed is dense"
(let [sc (freeze/head-mode {:mode :as-filmed} @frozen)]
(is (= [:dense :dense :dense]
(mapv #(ch/describe (of sc %))
[[:xform :pos] [:xform :rot] [:xform :scale]])))))
(testing "per plate is keyed at exactly the kept frames"
(let [sc (freeze/head-mode {:mode :per-plate :kept kept} @frozen)]
(doseq [path [[:xform :pos] [:xform :rot] [:xform :scale]]]
(is (= :keyed (ch/describe (of sc path))))
(is (= (sort kept) (sort (keys (:keys (of sc path))))))
;; A dense read is a VIEW into tier 2. Storing one in the document would
;; be storing a value that changes when a re-freeze rewrites the array
;; under it, so the keys hold plain data.
(doseq [[_ v] (:keys (of sc path))]
(is (or (number? v) (vector? v)) (str path " key is " (pr-str v)))))
;; And the keys are the dense track sampled at those frames, which is the
;; whole of what "per plate" means.
(is (= (mapv #(ch/value-at (get-in (node :head) [:measured [:xform :rot]]) % @store)
(sort kept))
(mapv (:keys (of sc [:xform :rot])) (sort kept))))))))
(deftest switching-modes-rewrites-the-head-and-nothing-else
;; It has to be impossible for the toggle to move something a hand placed, and
;; it has to be a DOCUMENT edit: tier 1, undoable, syncable, instant, and not a
;; reason to re-analyse.
(let [a (freeze/head-mode {:mode :free} @frozen)
b (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen)
c (freeze/head-mode {:mode :anchored :anchors {0 0, 40 40}} @frozen)]
(let [a (freeze/head-mode {:mode :as-filmed} @frozen)
b (freeze/head-mode {:mode :locked} @frozen)
c (freeze/head-mode {:mode :per-plate :kept #{0 40}} @frozen)]
(doseq [x [b c]]
(is (= (get (nodes a) :face) (get (nodes x) :face))
(is (= (get (clip/nodes a) :face) (get (clip/nodes x) :face))
":face moved")
(is (= (dissoc (nodes a) :head) (dissoc (nodes x) :head))
(is (= (dissoc (clip/nodes a) :head) (dissoc (clip/nodes x) :head))
"a node other than :head changed")
;; The measurement does not go away when the head is locked: always measure,
;; always store factored, toggle the parent.
(is (= (get-in (nodes a) [:head :measured])
(get-in (nodes x) [:head :measured])))
(is (= (get-in (clip/nodes a) [:head :measured])
(get-in (clip/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))))))
(deftest invalid-head-anchor-maps-are-refused
(is (thrown-with-msg? ExceptionInfo #"free or anchored"
(deftest a-head-mode-that-is-not-one-of-the-three-is-refused
(is (thrown-with-msg? ExceptionInfo #"not one of the three channel shapes"
(freeze/head-mode {:mode :stabilised} @frozen)))
(doseq [anchors [nil {} {12 12} {0 take/frames} {0 0, 10 -1}]]
(is (thrown-with-msg? ExceptionInfo #"frame-zero key"
(freeze/head-mode {:mode :anchored :anchors anchors} @frozen))))
(is (thrown-with-msg? ExceptionInfo #"has no anchors"
(freeze/head-mode {:mode :free :anchors {0 0}} @frozen))))
;; The kept-frame set belongs to the plate strip, not to measurement, so freeze
;; cannot invent one.
(is (thrown-with-msg? ExceptionInfo #"kept-frame set"
(freeze/head-mode {:mode :per-plate} @frozen))))
;; ---------------------------------------------------------------------------
;; the face: authored, and what makes makeXform deletable
@ -327,8 +327,8 @@
;; asking for a different stage moves and rescales the same geometry rather than
;; re-measuring anything.
(let [big (freeze/clip (assoc take/params :stage [640 480] :name "big")
{:face-1 @take/measured})
key-of (fn [c] (:store (:dense (get-in (nodes c)
@take/measured)
key-of (fn [c] (:store (:dense (get-in (clip/nodes c)
[:mouth :channels [:geom :pts]]))))]
(is (= [640 480] [(:width (:clip big)) (:height (:clip big))]))
;; Stronger than it was, and for free: the stage is not an input to tier 2, so
@ -340,7 +340,7 @@
(is (= (vec (array-seq (:data (get @store (key-of @clip*)))))
(vec (array-seq (:data (get (:store big) (key-of (:clip big)))))))
"the geometry is the same numbers at either stage size")
(is (not= (:value (get-in (nodes (:clip big))
(is (not= (:value (get-in (clip/nodes (:clip big))
[:face :channels [:xform :scale]]))
(:value (chan :face [:xform :scale]))))))
@ -418,14 +418,14 @@
(let [gap (set (range 40 60))
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))
(assoc @take/measured :presence presence))
tl (clip/root (:clip c))
at (fn [id f]
(ch/value-at (get-in (:nodes tl) [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])))
(is (= :face-1/eye-r (get-in (:clip c) [:features :face-1/eye-r :id])))
(is (= [:eye-r :eye-l] (get-in (:clip c) [:groups :eyes-1 :members])))
(is (= :eye-r (get-in (:clip c) [:features :eye-r :id])))
(is (not (ch/nothing? (at :eye-r 39))))
(is (ch/nothing? (at :eye-r 50)))
(is (not (ch/nothing? (at :eye-r 60))))
@ -456,8 +456,8 @@
(range take/frames))]))
windows)
c (freeze/clip (assoc take/params :name "per-track-gaps")
{:face-1 (assoc @take/measured :presence presence)})
tl (face-timeline (:clip c))
(assoc @take/measured :presence presence))
tl (clip/root (:clip c))
at (fn [id path f]
(ch/value-at (get-in (:nodes tl) [id :channels path]) f (:store c)))
;; Node, channel, and the feature whose gap it must follow. Every dense
@ -497,8 +497,7 @@
:shown (vec (repeat take/frames true))}
clip (fn [nm extra]
(freeze/clip (assoc take/params :name nm)
{:face-1 (merge (assoc @take/measured :teeth teeth-in)
extra)}))
(merge (assoc @take/measured :teeth teeth-in) extra)))
ref (clip "teeth-reference" nil)
occ (clip "teeth-mouth-gap"
{:presence {:mouth (mapv #(not (contains? gap %))
@ -506,7 +505,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 (timeline/resolver (clip/root (:clip c)) (:store c) pal/index-of)]
(fn [f] (into #{} (map :node) (r f)))))
ref-at (nodes-at ref)
occ-at (nodes-at occ)
@ -516,7 +515,7 @@
open (filter #(contains? (ref-at %) :teeth) (range take/frames))
inside (first (filter gap open))
outside (first (remove gap open))]
(is (= :mouth-in (get-in (nodes (:clip occ)) [:teeth :stencil]))
(is (= :mouth-in (get-in (clip/nodes (:clip occ)) [:teeth :stencil]))
"teeth stop inheriting the mouth's absence if this stops being their stencil")
(is (some? inside) "no open-mouth frame inside the gap to test with")
(is (some? outside) "no open-mouth frame outside the gap to test with")
@ -524,7 +523,7 @@
;; Annotating the MOUTH sets no bit on the teeth: they are a feature of
;; their own and nothing named them.
(is (not (ch/nothing?
(ch/value-at (get-in (nodes (:clip occ)) [:teeth :channels [:geom :pts]])
(ch/value-at (get-in (clip/nodes (:clip occ)) [:teeth :channels [:geom :pts]])
inside (:store occ)))))
;; They are dropped anyway — :mouth-in drew nothing to clip them against.
(is (not (contains? (occ-at inside) :mouth-in)))
@ -541,8 +540,8 @@
(let [gap (set (range 40 60))
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))
(assoc @take/measured :detected det))
tl (clip/root (:clip c))
res (timeline/resolver tl (:store c) pal/index-of)]
(doseq [f [39 40 50 59 60]]
(let [ops (res f)]
@ -598,11 +597,10 @@
;; from different beats are genuinely different mouths and frames inside one
;; beat are not. This is the numeric half of step 5's done-criterion; the other
;; half is a picture and lives in test/browser/take.mjs.
(let [locked (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen)
(let [locked (freeze/head-mode {:mode :locked} @frozen)
shot (fn [f]
(let [r (raster/make W H)
mouth (filter #(= [:face-1 :mouth] (:node %))
((clip/resolver locked @store pal/index-of) f))]
mouth (filter #(= :mouth (:node %)) (ops-at (clip/root locked) f))]
(raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r mouth)
(vec (array-seq (:buf r)))))
@ -616,6 +614,6 @@
(is (< (differ (shot 10) (shot 12)) 200)
"a held pose is moving more than the detector noise it should have lost"))
;; As filmed, the head carries it around the stage as well.
(let [filmed (freeze/head-mode {:mode :free} @frozen)]
(let [filmed (freeze/head-mode {:mode :as-filmed} @frozen)]
(is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300)
"the head does not move across the take")))

80
frontend/test/arthur/flow/ingest_test.cljs
View file

@ -15,52 +15,50 @@
(is (thrown? ExceptionInfo (ingest/feature-presence 8 bad)))))
;; ---------------------------------------------------------------------------
;; decoding the proxy
;; walking the proxy
;;
;; What used to be here was arithmetic mapping a browser clock to a frame number,
;; and it is gone with the seeking that needed it. `access-units` is the only pure
;; thing left in the decode path, and it is worth testing precisely because it is
;; the step that makes "chunk k is frame k" true.
;; These three are arithmetic, and all three were wrong in a way that no error
;; reported. A seek that lands one frame early, a timestamp read back with the
;; wrong inverse, or a frame time given as an index all produce a take that runs
;; to completion and is quietly off — which is why the numbers are asserted here
;; rather than left inline where they read as obvious.
(defn- annexb
"A tiny Annex-B stream: `[[nal-type ...] ...]`, one vector per access unit."
[units]
(js/Uint8Array.
(into-array (mapcat (fn [types]
(mapcat (fn [t] [0 0 0 1 t 0x42]) types))
units))))
(deftest a-seek-aims-at-the-middle-of-its-frame
;; THE BUG THIS ENCODES: seeking to `i/fps` sits exactly on the boundary between
;; two frames, and over 91 frames of real footage it produced the PREVIOUS frame
;; 31 times. Every seek must land strictly inside its own frame's interval, with
;; half a frame of slack on each side.
(doseq [fps [12 23.976 24 25 29.97 30 60]]
(testing (str fps "fps")
(doseq [i [0 1 2 41 90 899]]
(let [t (ingest/seek-time fps i)]
(is (< (/ i fps) t (/ (inc i) fps))
(str "frame " i " at " fps "fps seeks to " t
", outside [" (/ i fps) ", " (/ (inc i) fps) ")"))
;; Within a rounding error of dead centre. Not `=`: `(/ i fps)` and
;; `(/ (+ i 0.5) fps)` are two different divisions, so their difference
;; carries the last bit of both and 0.4999999999999982 is a pass.
(is (< (abs (- 0.5 (* fps (- t (/ i fps))))) 1e-9)
"the aim point drifted off the middle of the frame"))))))
(deftest access-units-cut-the-stream-at-coded-frames
;; Types 1 and 5 are slices; 7, 8 and 6 are SPS, PPS and SEI, which belong to
;; the frame that FOLLOWS them. Getting that boundary wrong would shift every
;; parameter set onto the previous frame and make the first chunk undecodable.
(let [bytes (annexb [[7 8 5] [1] [1] [7 8 5] [1]])
units (ingest/access-units bytes)]
(is (= 5 (count units)) "one access unit per coded slice")
(is (= [true false false true false] (mapv :key? units))
"an IDR slice makes its access unit a keyframe")
(is (apply < (mapv :from units)) "units are in stream order")
(is (= (mapv :to units)
(mapv :from (concat (rest units) [{:from (.-length bytes)}])))
"units tile the stream with no bytes dropped between them")))
(deftest a-presented-media-time-reads-back-as-its-own-frame
;; The inverse of `i/fps` and NOT of `seek-time`: requestVideoFrameCallback
;; reports the frame's START. Rounding the wrong one is a silent off-by-one
;; between the landmarks and the audio.
(doseq [fps [12 24 29.97 30]]
(doseq [i [0 1 2 41 90]]
(is (= i (ingest/presented-frame fps (/ i fps)))
(str "frame " i " at " fps "fps did not read back as itself")))))
(deftest a-stream-of-one-frame-is-one-unit
(is (= 1 (count (ingest/access-units (annexb [[7 8 5]]))))))
(deftest three-byte-and-four-byte-start-codes-are-both-found
;; Both are legal and ffmpeg emits both: four bytes before parameter sets and
;; three between slices. Missing the short form merges two frames into one.
(let [bytes (js/Uint8Array. (into-array [0 0 0 1 5 0x42 0 0 1 1 0x42 0 0 1 1 0x42]))]
(is (= 3 (count (ingest/access-units bytes))))))
(deftest a-frame-time-is-footage-milliseconds-and-strictly-increasing
(deftest a-frame-time-is-footage-milliseconds-and-not-a-frame-number
;; MediaPipe's video mode is a tracker that reads the gap between timestamps as
;; motion, and its input stream refuses one that does not advance — an error the
;; landmarker never recovers from.
;; motion. Handing it `i` still runs, and measurably moved landmarks six times
;; further from the per-frame answer. It must be real elapsed time.
(is (= 0.0 (ingest/frame-ms 12 0)))
(is (= 1000.0 (ingest/frame-ms 12 12)))
(is (= (/ 1000 30) (ingest/frame-ms 30 1)))
(doseq [fps [12 23.976 30 60 240]]
(let [times (mapv #(ingest/frame-ms fps %) (range 200))]
(is (every? pos? (map - (rest times) times))
(str "two frames at " fps "fps shared a timestamp")))))
(testing "strictly increasing, which the input stream requires"
(doseq [fps [12 23.976 30 60 240]]
(let [times (mapv #(ingest/frame-ms fps %) (range 200))]
(is (every? pos? (map - (rest times) times))
(str "two frames at " fps "fps shared a timestamp"))))))

1
frontend/test/arthur/flow/measure/mouth_test.cljs
View file

@ -1,5 +1,4 @@
(ns arthur.flow.measure.mouth-test
(:refer-clojure :exclude [spread])
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.landmarks :as lm]
[arthur.domain.ring :as ring]

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

@ -1,190 +0,0 @@
(ns arthur.flow.multi-face-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.feature :as feature]
[arthur.domain.pose :as pose]
[arthur.domain.project :as project]
[arthur.events.footage :as footage]
[arthur.flow.address :as address]
[arthur.flow.detect :as detect]
[arthur.flow.freeze :as freeze]
[arthur.flow.regenerate :as regenerate]
[arthur.flow.source :as source]
[arthur.flow.take :as take]
[arthur.support.ops :as ops]
[arthur.synth :as synth]))
(def frames 40)
(def settings
(merge take/knobs {:name "two faces" :fps 30 :aspect 1 :stage [320 200]
:fit-motion? true :expose 1 :head :anchored :anchors {0 0}
:analysis (address/analysis {:detector "synth" :version "two-faces-v1"
:seed 9 :frames frames :fps 30 :aspect 1})}))
(def inputs
(delay
(into {} (for [[id seed dx] [[:face-1 9 -0.3] [:face-2 12 0.3]]]
[id {:dense (mapv (fn [face] (mapv #(update % :x + dx) face))
(synth/synth-dense frames {:seed seed}))
:detected (vec (repeat frames true))
:crops (vec (repeat frames nil))}]))))
(def initial
(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)))
(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])]
(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])))
(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]))))))
(let [drawn (by-node clip store 12)
left (get drawn [:face-1 :mouth])
right (get drawn [:face-2 :mouth])]
(is (seq (:points left)))
(is (< (ffirst (:points left)) (ffirst (:points right)))
"one shared placement preserves the filmed separation"))
(is (some #(re-find #"more than one feature" %)
(feature/problems
(assoc-in clip [:features :duplicate]
(assoc (get-in clip [:features :face-2/mouth]) :id :duplicate)))))))
(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]]
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 (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 (empty? (clip/problems anchored)))))
(deftest the-second-subject-regenerates-inside-a-composed-stage
(let [before (update @initial :clip stage/compose)
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 (empty? (clip/problems (:clip after))))
(is (thrown? ExceptionInfo
(freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 frames}}
after))
"anchors are bounded by the source timeline, even on a longer stage")))
(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)
original (by-node clip store 4)
held (by-node cut store 4)
source (by-node clip store 20)]
(is (empty? (clip/problems cut)))
(is (= (get held [:face-2 :mouth]) (get source [:face-2 :mouth])))
(is (not= (get held [:face-2 :mouth]) (get original [:face-2 :mouth])))
(doseq [id [[:face-1 :mouth] [:face-1 :eye-r] [:face-2 :eye-r]]]
(is (= (get held id) (get original id))))))
(deftest detection-and-feature-gaps-are-per-subject
(let [inputs (-> @inputs
(assoc-in [:face-2 :detected 8] false)
(assoc-in [:face-2 :presence :eye-r]
(assoc (vec (repeat frames true)) 12 false)))
{:keys [clip store]} (take/build settings inputs)
clip (freeze/head-mode {:mode :free} {:clip clip})
at8 (by-node clip store 8)
at12 (by-node clip store 12)]
(is (some? (get at8 [:face-1 :mouth])))
(is (nil? (get at8 [:face-2 :mouth])))
(is (nil? (get at12 [:face-2 :eye-r])))
(is (nil? (get at12 [:face-2 :iris-r])))
(is (some? (get at12 [:face-1 :eye-r])))
(is (some? (get at12 [:face-2 :eye-l])))
(is (some? (get (by-node clip store 13) [:face-2 :eye-r])))))
(deftest nested-faces-survive-save-and-resolve-through-the-stage
(let [entry (update @initial :clip stage/compose)
back (project/load "two" (js/JSON.parse (js/JSON.stringify (project/save "two" entry))))]
(is (= (:clip entry) (:clip back)))
(is (empty? (clip/problems (:clip back))))
(doseq [f [0 12 30 10]]
(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 (= (snapshot (:clip entry) (:store entry) f)
(snapshot (:clip back) (:store back) f))))))
(deftest source-round-trip-keeps-two-faces-with-identical-detection-masks
(let [blocks (source/pack-subjects (get-in settings [:analysis :id]) @inputs)
wire (source/wire-blocks blocks)
back (:subjects (source/unpack (.reverse wire) [320 200]))]
(is (= 6 (count (set (source/block-keys blocks)))) )
(doseq [subject [:face-1 :face-2]]
(is (= (select-keys (get @inputs subject) [:dense :detected])
(select-keys (get back subject) [:dense :detected]))))))
(deftest reordered-detections-and-gaps-retain-their-track
(let [a [{:x 0.1 :y 0.5}] b [{:x 0.8 :y 0.5}]
frames [[a] [b a] [] [a b]]
tracks (detect/tracks frames)]
(is (= {:face-1 [0 1 nil 0] :face-2 [nil 0 nil 1]} tracks))
(is (= [false true false true]
(:detected (detect/fill-gaps (detect/pick frames (:face-2 tracks))))))
(is (thrown? ExceptionInfo (detect/tracks [[] []])))))
(deftest manifest-masks-enter-measurement-with-local-feature-names
(let [manifest {:presence {:eye-l [false true]
:face-1/eye-r [true false]
:face-2/eye-r [false true]}}]
(is (= {:eye-l [false true] :eye-r [true false]}
(footage/presence-for manifest :face-1)))
(is (= {:eye-r [false true]} (footage/presence-for manifest :face-2)))))
(deftest tracking-settings-participate-in-the-analysis-address
(let [manifest {:width 320 :height 200 :frames 40 :fps 30 :source "source"}
analysis (take/analysis-for manifest {:version "test"})]
(is (= detect/settings (:tracking analysis)))
(is (not= (:id analysis) (:id (address/analysis (dissoc analysis :tracking)))))
(is (not= (:id analysis)
(:id (address/analysis (assoc-in analysis [:tracking :gate] 0.3)))))))
(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])
[:head :parent] :face)))
nested (clip/resolver clip store)
reference (clip/resolver flat store)]
(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)))
(doseq [[x y] (map vector a b)]
(is (= (:kind x) (:kind y)))
(doseq [[u v] (map vector
(concat (mapcat identity (:points x)) (keep x [:cx :cy :r :size]))
(concat (mapcat identity (:points y)) (keep y [:cx :cy :r :size])))]
(is (< (abs (- u v)) 1e-8))))))))

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

@ -1,258 +0,0 @@
(ns arthur.flow.regenerate-test
(:require [cljs.test :refer [deftest is testing]]
[clojure.walk :as walk]
[arthur.demo.stage :as stage]
[arthur.domain.clip :as clip]
[arthur.domain.params :as params]
[arthur.domain.project :as project]
[arthur.flow.address :as address]
[arthur.flow.freeze :as freeze]
[arthur.flow.regenerate :as regenerate]
[arthur.flow.take :as take]
[arthur.synth :as synth]))
(def ^:private frames 40)
(def ^:private inputs (delay {:dense (synth/synth-dense frames {:seed 9})}))
(def ^:private initial
(delay
(let [p (merge take/knobs
{:name "regen" :fps 30 :aspect 1 :stage [320 200]
:expose 1 :head :free
:analysis (address/analysis
{:detector "synth" :version "mulberry32"
:seed 9 :frames frames :fps 30 :aspect 1})})]
(assoc (take/build p {:face-1 @inputs}) :source-inputs {:subjects {:face-1 @inputs}}))))
(defn- full-at [change]
(take/build
(merge take/knobs
{:name "regen" :fps 30 :aspect 1 :stage [320 200]
:expose 1 :head :free
:analysis (get-in @initial [:clip :analysis])}
change)
{:face-1 @inputs}))
(defn- channel [entry node path]
(get-in entry [:clip :timelines :face-1 :nodes node :channels path]))
(deftest eye-rebuild-is-confined-to-the-edited-feature
(let [before @initial
after (regenerate/change before
{:scope :feature :id :face-1/eye-r :knob :gaze-gain :value 2})]
(is (not= (channel before :iris-r [:xform :pos])
(channel after :iris-r [:xform :pos])))
(is (= (channel before :iris-l [:xform :pos])
(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 (= (channel (full-at {:gaze-gain 2}) :iris-r [:xform :pos])
(channel after :iris-r [:xform :pos])))))
(deftest framed-eye-size-needs-no-new-dense-block
(let [before @initial
after (regenerate/change before
{:scope :feature :id :face-1/eye-r :knob :iris-size :value 0.6})]
(is (not= (channel before :iris-r [:geom :radius])
(channel after :iris-r [:geom :radius])))
(is (= (channel before :iris-l [:geom :radius])
(channel after :iris-l [:geom :radius])))
(is (= (channel (full-at {:iris-size 0.6}) :iris-r [:geom :radius])
(channel after :iris-r [:geom :radius])))
(is (= (set (keys (:store before))) (set (keys (:store after)))))))
(deftest mouth-edit-leaves-the-head-and-eye-alone
(let [before @initial
after (regenerate/change before
{: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 (= (channel before :eye-r [:geom :pts])
(channel after :eye-r [:geom :pts])))
(is (= (channel (full-at {:verts 10}) :mouth [:geom :pts])
(channel after :mouth [:geom :pts])))))
(deftest subject-edit-recomputes-head-and-keeps-authored-placement
(let [before @initial
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])))))
(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 (= (channel before :teeth [:geom :pts])
(channel after :teeth [:geom :pts])))))
(deftest edited-take-still-round-trips-through-normal-save
(let [after (regenerate/change @initial
{:scope :group :id :face-1/eyes :knob :iris-size :value 0.6})
wire (project/save "regen" after)
loaded (project/load "regen" (js/JSON.parse (js/JSON.stringify wire)))]
(is (= (:clip after) (:clip loaded)))
(is (= (channel after :iris-r [:geom :radius])
(channel loaded :iris-r [:geom :radius])))))
;; ---------------------------------------------------------------------------
;; the dirty set
(def ^:private crossings
"A threshold knob needs a value that CROSSES something or a re-freeze proves
nothing about it. `:aperture-cut` is a fraction of the widest frame's aperture
and the synthetic mouth is open on every frame, so gating one takes a value near
the top of its range rather than a nudge off the default."
{:aperture-cut 0.9})
(defn- bump [id]
(let [{:keys [type default] must-even? :even?} (get params/definitions id)]
(if-let [crossing (get crossings id)]
crossing
(cond (and (= :integer type) must-even?) (+ default 2)
(= :integer type) (+ default 1)
(zero? default) 0.5
:else (* default 1.75)))))
(def ^:private fixture-blind
"Knobs a synthetic dense track cannot move, stated rather than quietly skipped.
The teeth's thresholds and its vertex budget reach the contour through
`source/measure-crop` — real pixels, an otsu threshold and a radial sweep, all
above the stage this fixture starts at — so they are `address-test`'s half of the
same table, asserted there at the descriptor. And `:blink-cut` needs a face that
blinks: it gates `[:vis]` keys, the synthetic eyes never shut, and a threshold
with nothing to cross reads as a knob the eye does not have."
#{:cavity-erode :tongue-reject :blob-grow :top-bias :teeth-verts :min-area
:blink-cut})
(def ^:private interior-track
"A contour and a contrast on every frame, both moving, so `condition/interior`
has its own decisions to make. Contrast runs in five-frame blocks either side of
`teeth-on` because the threshold has hysteresis and a dwell: a one-frame dip is
suppressed on purpose, and a fixture that only dipped for one frame would report
`:teeth-on` as a knob the teeth do not read."
(delay
(vec (for [f (range frames)]
{:contrast (if (< (mod f 10) 5) 0.15 0.45)
:area (+ 30 (mod f 3))
:contour (vec (for [i (range (:teeth-verts take/knobs))]
{:x (+ 0.45 (* 0.02 (js/Math.cos (+ i f))))
:y (+ 0.5 (* 0.02 (js/Math.sin (+ i f))))}))}))))
(defn- plain [x]
(if (some? (some-> x .-BYTES_PER_ELEMENT)) (vec (array-seq x)) x))
(defn- output
"A frozen part as a VALUE, which is what makes the comparison below mean
anything: a block's `:data` is a typed array and two of those are never `=`
however identical their contents, so an unguarded `=` reports every part as
different and proves nothing in either direction.
The block KEYS are elided and the bytes are not. A key that moved is
`block-knobs` agreeing with itself; the bytes and the tier-1 channels are the
fact. `address-test` draws the line in the same place."
[part]
{:blocks (into #{} (map (fn [[_ b]] [(plain (:data b)) (plain (:state b))]))
(:store part))
:channels (walk/postwalk #(if (map? %) (dissoc % :store) %) (:nodes part))})
(defn- part-at [area overrides]
(let [p (merge take/knobs
{:fps 30 :aspect 1 :analysis (get-in @initial [:clip :analysis])}
overrides)
inputs (assoc @inputs :interior @interior-track)]
(freeze/part :face-1 area p (take/measure-part area p inputs (take/anchor-base p inputs)))))
(def ^:private swept
"Per area, the knobs whose bytes or channels that area's freeze could plausibly
read at all — its own, plus the subject's two that every feature inherits."
{:mouth #{:anchor-avg :contour-avg :verts :aperture-cut}
:eye (into #{:anchor-avg :contour-avg} (keys (params/for-area :eye)))
:brow (into #{:anchor-avg :contour-avg} (keys (params/for-area :brow)))
:teeth #{:anchor-avg :contour-avg :aperture-cut :teeth-on :teeth-smooth}})
(deftest area-knobs-is-asserted-by-re-freezing-each-part
;; The biconditional `address-test` runs per BLOCK, run per feature AREA and
;; across both tiers. This is the question a regeneration asks — "is this
;; feature stale" — and `plan` used to answer it with a hand-written case per
;; knob, on the one side of the table nothing checked.
(doseq [[area knobs] (sort-by (comp str key) swept)
id (sort (remove fixture-blind knobs))]
(let [dirty? (contains? (address/area-knobs area) id)
same? (= (output (part-at area {}))
(output (part-at area {id (bump id)})))]
(testing (str area " " id " " (get params/defaults id) " -> " (bump id))
(is (= (not same?) dirty?)
(str "the frozen part is " (if same? "unchanged" "different")
" but area-knobs says " (if dirty? "dirty" "clean") " — "
(if same?
(str "remove " id " from " area "'s roles or framed-knobs")
(str "add " id " to " area "'s roles or framed-knobs"))))))))
;; ---- the stage: a shared symbol behind many placements ----
(defn- staged [] (update @initial :clip stage/compose))
(defn- sym-channel [entry node path] (channel entry node path))
(deftest a-stage-edit-is-previewable-at-all
;; The guard `events/project/::preview-settings` bails on, stated here so a
;; document that cannot be previewed fails in the suite rather than as a slider
;; that silently does nothing in the browser.
(let [entry (staged)]
(is (some? (:analysis (:clip entry)))
"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 %))
(vals (:features (:clip entry))))))))
(deftest a-stage-edit-plans-the-same-features-as-a-take-edit
(let [edit {:scope :feature :id :face-1/eye-r :knob :iris-size :value 0.6}]
(is (= (:features (regenerate/plan (:clip @initial) edit))
(:features (regenerate/plan (:clip (staged)) edit)))
"the same knob dirties the same features on a stage as on a take")))
(deftest a-stage-edit-rewrites-the-shared-symbol
;; The payoff of the symbol being shared: ONE edit, and every placement reads it
;; on the next paint. So the changed channel has to land in the symbol timeline,
;; and `:main` — which holds only placements — must come back untouched.
(let [before (staged)
after (regenerate/change before
{:scope :feature :id :face-1/eye-r :knob :iris-size :value 0.6})]
(is (not= (sym-channel before :iris-r [:geom :radius])
(sym-channel after :iris-r [:geom :radius]))
"the shared drawing is what changed")
(is (= (sym-channel before :iris-l [:geom :radius])
(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]))))
(testing "and the document is still a document"
(is (empty? (clip/problems (:clip after)))))))
(deftest a-stage-edit-keeps-every-placement-and-its-link
;; A regeneration that dropped or re-keyed the placements would take the seven
;; faces off the stage, or dangle the voice links, while looking like a
;; 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)]
(is (= 7 (count syms)))
(is (every? uuid? (map key syms)))
(doseq [[_ n] (filter (comp #{:audio} :kind val) nodes)]
(is (contains? nodes (:linked-to n))
(str "the voice " (:id n) " still links to a node that is there")))))

43
frontend/test/arthur/flow/source_test.cljs
View file

@ -1,33 +1,14 @@
(ns arthur.flow.source-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.params :as params]
[arthur.domain.wire :as wire]
(:require [cljs.test :refer [deftest is]]
[arthur.flow.source :as source]))
(deftest pixel-measurements-have-their-own-addressed-block
(let [settings params/defaults
ring (mapv (fn [i] {:x (/ i 10) :y (/ (+ i 1) 20)})
(range (:teeth-verts settings)))
measures [{:contour ring :contrast 0.7 :area 42}
{:contour nil :contrast 0 :area 0}]
block (source/interior-block "sha256:analysis" :face-1 settings measures)
response #js {:descriptor (:descriptor block)
:data (wire/base64 (:data block))}]
(is (= (:key block)
(source/interior-key "sha256:analysis" :face-1 settings 2)))
(is (= measures (source/unpack-interior response settings 2)))
(is (not= (:key block)
(source/interior-key "sha256:analysis" :face-1
(assoc settings :cavity-erode 0.2) 2)))))
(deftest source-blocks-round-trip-without-source-images
(let [face (vec (repeat 478 {:x 0.25 :y 0.5 :z -0.125}))
pixels (js/Uint8ClampedArray. #js [12 24 36 255])
input {:dense [face face] :detected [true false]
:crops [{:box {:x 3 :y 4 :w 1 :h 1} :data pixels} nil]}
blocks (source/pack "sha256:analysis" :face-1 input)
out (get-in (source/unpack (source/wire-blocks {:face-1 blocks}) [100 80])
[:subjects :face-1])]
blocks (source/pack "sha256:analysis" input)
out (source/unpack (source/wire-blocks blocks) [100 80])]
(is (= (set source/roles) (set (keys blocks))))
(is (= (:dense input) (:dense out)))
(is (= (:detected input) (:detected out)))
@ -37,20 +18,4 @@
(vec (array-seq (:data (first (:crops out)))))))
(is (nil? (second (:crops out))))
(is (= (mapv :key (vals blocks))
(mapv :key (vals (source/pack "sha256:analysis" :face-1 out)))))))
(deftest fresh-source-includes-its-pixel-measurement-block
(let [face (vec (repeat 478 {:x 0.25 :y 0.5 :z -0.125}))
input {:dense [face] :detected [false] :crops [nil]
:interior [{:contour nil :contrast 0 :area 0}]
:interior-settings params/defaults}
blocks (source/pack "sha256:analysis" :face-1 input)]
(is (contains? blocks "source/interior"))
(is (= 4 (.-length (source/upload-blocks {:face-1 blocks}))))
(is (= 3 (count source/roles)))
(testing "and cannot be packed without the settings it was measured at"
;; The block is addressed BY those knobs. Defaulting them would name it
;; after settings its bytes did not come from, which is a key that lies.
(is (thrown-with-msg?
ExceptionInfo #"needs the settings"
(source/pack "sha256:analysis" :face-1 (dissoc input :interior-settings)))))))
(mapv :key (vals (source/pack "sha256:analysis" out)))))))

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

@ -233,8 +233,7 @@ async function main() {
if (probe && probe.drawn > 0) 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?'));
if (!probe) throw new Error('no canvas.stage on the page — is `shadow-cljs watch app` running?');
console.log(`\ncanvas ${probe.w}x${probe.h}, clip ${JSON.stringify(probe.selectedClip)}`);
@ -254,7 +253,6 @@ async function main() {
await sleep(120);
const open = await page.eval(PROBE);
await page.shot('take-open');
check(open.toneSet.includes(0x171a22), 'nested face pupils reach the rasterizer');
check(open.toneSet.includes(MOUTH_DARK),
'an open mouth draws an outline and an interior',
`${open.tones} tones, interior ${open.toneSet.includes(MOUTH_DARK) ? 'present' : 'MISSING'}`);
@ -395,246 +393,6 @@ async function main() {
check(!back[0].selectedClip.includes('take'), 'the picture is the reopened document',
JSON.stringify(back[0].selectedClip));
// Paint through the visible controls. This exercises the SVG pointer path,
// the authored node, the raster preview and the document round trip.
await page.eval(SEEK(0));
await sleep(150);
const beforePaint = await page.eval(`(() => {
const c = document.querySelector('canvas.stage');
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');
button.click();
const svg = document.querySelector('.paint-overlay');
const box = svg.getBoundingClientRect();
for (const [x, y] of [[10, 10], [40, 10], [25, 40]]) {
svg.dispatchEvent(new PointerEvent('pointerdown', {
bubbles: true, clientX: box.left + x * box.width / 320,
clientY: box.top + y * box.height / 200,
}));
}
return true;
})()`);
await sleep(100);
const finished = await page.eval(`(() => {
const button = [...document.querySelectorAll('.paint-tools button')]
.find(b => b.textContent === 'finish shape');
if (!button || button.disabled) return false;
button.click();
return true;
})()`);
await sleep(250);
const afterPaint = await page.eval(`(() => {
const c = document.querySelector('canvas.stage');
const d = c.getContext('2d').getImageData(25, 20, 1, 1).data;
return [...d];
})()`);
check(painted && finished && beforePaint.join(',') !== afterPaint.join(','),
'a polygon drawn with the paint controls appears on the canvas');
for (const f of [8, 16]) {
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');
if (!button || button.disabled) return false;
button.click();
return true;
})()`), `a drawing key can be added at frame ${f}`);
await sleep(100);
}
await page.eval(SEEK(8));
await sleep(100);
const tweenSelected = await page.eval(`(() => {
const label = [...document.querySelectorAll('.paint-tools label')]
.find(el => el.textContent.startsWith('key 8 → 16'));
const select = label?.querySelector('select');
if (!select) return false;
select.value = 'linear';
select.dispatchEvent(new Event('change', { bubbles: true }));
return true;
})()`);
await sleep(100);
check(tweenSelected && await page.eval(`(() => {
const label = [...document.querySelectorAll('.paint-tools 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(/opened /)) !== null,
'the painted shape is reopened', await page.eval(STATUS));
await sleep(150);
const reopenedPaint = await page.eval(`(() => {
const c = document.querySelector('canvas.stage');
return [...c.getContext('2d').getImageData(25, 20, 1, 1).data];
})()`);
check(afterPaint.join(',') === reopenedPaint.join(','),
'the painted polygon survives the project round trip');
await page.eval(SEEK(8));
await sleep(100);
check(await page.eval(`(() => {
const label = [...document.querySelectorAll('.paint-tools 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');
// The local 8625 study is optional in a fresh test database. When present,
// tune its shared symbol while its stage is playing.
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');
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');
// 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'));
if (!option) return false;
select.value = option.value;
select.dispatchEvent(new Event('change', { bubbles: true }));
return true;
})()`);
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');
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
// otherwise reports a y outside the window, the click lands on nothing,
// and the failure reads as "regeneration is broken" rather than "the
// slider was off-screen". Which is exactly what it read as once.
row.scrollIntoView({ block: 'center' });
const r = row.querySelector('input').getBoundingClientRect();
return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 };
})()`);
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])`);
await page.send('Input.dispatchMouseEvent', {
type: 'mousePressed', x: irisSlider.x, y: irisSlider.y, button: 'left', clickCount: 1,
});
await page.send('Input.dispatchMouseEvent', {
type: 'mouseReleased', x: irisSlider.x, y: irisSlider.y, button: 'left', clickCount: 1,
});
const preview = await statusMatching(/preview · unsaved/, 160);
const debug = await page.eval(`document.querySelector('.regeneration-debug')?.textContent ?? ''`);
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])`);
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 option = [...select.options]
.find(o => o.textContent.includes('subject · face-1'));
if (!option) return false;
select.value = option.value;
select.dispatchEvent(new Event('change', { bubbles: true }));
return true;
})()`);
check(subjectSelected, 'the stage exposes its tracked subject');
if (subjectSelected) {
await sleep(100);
const anchorSlider = await page.eval(`(() => {
const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.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
// otherwise reports a y outside the window, the click lands on nothing,
// and the failure reads as "regeneration is broken" rather than "the
// slider was off-screen". Which is exactly what it read as once.
row.scrollIntoView({ block: 'center' });
const r = row.querySelector('input').getBoundingClientRect();
return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 };
})()`);
check(anchorSlider !== null, 'the subject has an anchor slider');
if (anchorSlider) {
const anchorStart = Date.now();
await page.send('Input.dispatchMouseEvent', {
type: 'mousePressed', x: anchorSlider.x, y: anchorSlider.y,
button: 'left', clickCount: 1,
});
await page.send('Input.dispatchMouseEvent', {
type: 'mouseReleased', x: anchorSlider.x, y: anchorSlider.y,
button: 'left', clickCount: 1,
});
let debug = '';
for (let i = 0; i < 160; i++) {
debug = await page.eval(`document.querySelector('.regeneration-debug')?.textContent ?? ''`);
if (debug.includes('head-pos')) break;
await sleep(250);
}
check(debug.includes('head-pos') && debug.includes(':face-1/teeth'),
'anchor invalidates the head and teeth', debug);
const preview = await statusMatching(/preview · unsaved/, 160);
check(preview !== null, 'the anchor edit finishes previewing',
preview ? `${Date.now() - anchorStart}ms` : (await page.eval(STATUS)));
}
}
const teethSelected = await page.eval(`(() => {
const select = document.querySelector('.controls select');
const option = [...select.options]
.find(o => o.textContent.trim().endsWith('feature · face-1/teeth'));
if (!option) return false;
select.value = option.value;
select.dispatchEvent(new Event('change', { bubbles: true }));
return true;
})()`);
check(teethSelected, 'the stage exposes its tracked teeth');
if (teethSelected) {
await sleep(100);
const slider = await page.eval(`(() => {
const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.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
// otherwise reports a y outside the window, the click lands on nothing,
// and the failure reads as "regeneration is broken" rather than "the
// slider was off-screen". Which is exactly what it read as once.
row.scrollIntoView({ block: 'center' });
const r = row.querySelector('input').getBoundingClientRect();
return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 };
})()`);
check(slider !== null, 'the teeth have a pixel-setting slider');
if (slider) {
await page.send('Input.dispatchMouseEvent', {
type: 'mousePressed', x: slider.x, y: slider.y,
button: 'left', clickCount: 1,
});
await page.send('Input.dispatchMouseEvent', {
type: 'mouseReleased', x: slider.x, y: slider.y,
button: 'left', clickCount: 1,
});
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;
await sleep(250);
}
check(debug.includes('dirty features: [: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',
preview ?? (await page.eval(STATUS)));
}
}
}
// Exercise the actual file input and FormData path, then wait for the
// extraction job's footage to appear in the server list.
const uploadDir = mkdtempSync(join(tmpdir(), 'arthur-upload-'));