Compare commits
4 commits
da7e293814
...
ae03b61dca
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ae03b61dca | ||
|
|
309c47e0a7 | ||
|
|
550cfe91e5 | ||
|
|
2a0426707a |
42 changed files with 1747 additions and 307 deletions
|
|
@ -161,6 +161,18 @@ def _extract_stills(job, proxy_path, frames_dir, frames, root):
|
||||||
MAX_RATE = 120 # a capture rate; past this the container is describing something else
|
MAX_RATE = 120 # a capture rate; past this the container is describing something else
|
||||||
|
|
||||||
|
|
||||||
|
def probe_audio(path):
|
||||||
|
"""The length of an uploaded sound in seconds, refusing a file with no audio."""
|
||||||
|
data = json.loads(_command(["ffprobe", "-v", "error", "-show_streams",
|
||||||
|
"-show_format", "-of", "json", str(path)]))
|
||||||
|
if not any(s.get("codec_type") == "audio" for s in data.get("streams", [])):
|
||||||
|
raise ValueError("the uploaded file has no audio stream")
|
||||||
|
duration = float(data.get("format", {}).get("duration") or 0)
|
||||||
|
if duration <= 0:
|
||||||
|
raise ValueError("the sound's length is unknown")
|
||||||
|
return duration
|
||||||
|
|
||||||
|
|
||||||
def probe(path):
|
def probe(path):
|
||||||
"""What the upload is, as far as choosing a proxy rate goes.
|
"""What the upload is, as far as choosing a proxy rate goes.
|
||||||
|
|
||||||
|
|
|
||||||
25
clips/migrations/0010_sounds.py
Normal file
25
clips/migrations/0010_sounds.py
Normal file
|
|
@ -0,0 +1,25 @@
|
||||||
|
# Generated by Django 5.2.17 on 2026-09-30 07:14
|
||||||
|
|
||||||
|
import django.db.models.deletion
|
||||||
|
import uuid
|
||||||
|
from django.db import migrations, models
|
||||||
|
|
||||||
|
|
||||||
|
class Migration(migrations.Migration):
|
||||||
|
|
||||||
|
dependencies = [
|
||||||
|
('clips', '0009_revision_blocks'),
|
||||||
|
]
|
||||||
|
|
||||||
|
operations = [
|
||||||
|
migrations.CreateModel(
|
||||||
|
name='Sound',
|
||||||
|
fields=[
|
||||||
|
('id', models.UUIDField(default=uuid.uuid4, editable=False, primary_key=True, serialize=False)),
|
||||||
|
('filename', models.CharField(max_length=255)),
|
||||||
|
('duration', models.FloatField(help_text='seconds, as ffprobe reports it')),
|
||||||
|
('created', models.DateTimeField(auto_now_add=True)),
|
||||||
|
('blob', models.ForeignKey(on_delete=django.db.models.deletion.PROTECT, related_name='sound_for', to='clips.blob')),
|
||||||
|
],
|
||||||
|
),
|
||||||
|
]
|
||||||
|
|
@ -52,6 +52,18 @@ class Source(models.Model):
|
||||||
created = models.DateTimeField(auto_now_add=True)
|
created = models.DateTimeField(auto_now_add=True)
|
||||||
|
|
||||||
|
|
||||||
|
class Sound(models.Model):
|
||||||
|
"""An uploaded sound file — mp3, wav, whatever the browser can decode — kept
|
||||||
|
as uploaded. Not footage: it has no frames and nothing measures it, so it
|
||||||
|
skips extraction and an audio node plays its bytes directly."""
|
||||||
|
|
||||||
|
id = models.UUIDField(primary_key=True, default=uuid.uuid4, editable=False)
|
||||||
|
blob = models.ForeignKey(Blob, on_delete=models.PROTECT, related_name="sound_for")
|
||||||
|
filename = models.CharField(max_length=255)
|
||||||
|
duration = models.FloatField(help_text="seconds, as ffprobe reports it")
|
||||||
|
created = models.DateTimeField(auto_now_add=True)
|
||||||
|
|
||||||
|
|
||||||
class Extraction(models.Model):
|
class Extraction(models.Model):
|
||||||
"""One requested decode of a source into immutable footage."""
|
"""One requested decode of a source into immutable footage."""
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -34,7 +34,7 @@ from django.core.management import call_command
|
||||||
from django.test import TestCase, override_settings
|
from django.test import TestCase, override_settings
|
||||||
|
|
||||||
from clips import blobs, extraction
|
from clips import blobs, extraction
|
||||||
from clips.models import Analysis, Block, Blob, Clip, Footage, Leaf, Project, Revision, Source
|
from clips.models import Analysis, Block, Blob, Clip, Footage, Leaf, Project, Revision, Sound, Source
|
||||||
|
|
||||||
BLOB_DIR = tempfile.mkdtemp(prefix="arthur-test-blobs-")
|
BLOB_DIR = tempfile.mkdtemp(prefix="arthur-test-blobs-")
|
||||||
|
|
||||||
|
|
@ -721,6 +721,36 @@ class UploadTests(TestCase):
|
||||||
self.assertEqual(27, job.progress)
|
self.assertEqual(27, job.progress)
|
||||||
job.save.assert_called_once_with(update_fields=["progress", "updated"])
|
job.save.assert_called_once_with(update_fields=["progress", "updated"])
|
||||||
|
|
||||||
|
def test_an_uploaded_mp3_is_a_sound_and_not_footage(self):
|
||||||
|
with tempfile.TemporaryDirectory() as directory:
|
||||||
|
path = Path(directory) / "tone.mp3"
|
||||||
|
subprocess.run([
|
||||||
|
"ffmpeg", "-hide_banner", "-loglevel", "error", "-y",
|
||||||
|
"-f", "lavfi", "-i", "sine=frequency=440:duration=1.5", str(path),
|
||||||
|
], check=True, capture_output=True)
|
||||||
|
payload = path.read_bytes()
|
||||||
|
|
||||||
|
uploaded = self.client.post("/api/sounds", {
|
||||||
|
"file": SimpleUploadedFile("tone.mp3", payload, content_type="audio/mpeg")})
|
||||||
|
self.assertEqual(201, uploaded.status_code, uploaded.content)
|
||||||
|
sound = uploaded.json()
|
||||||
|
self.assertEqual("tone.mp3", sound["label"])
|
||||||
|
self.assertAlmostEqual(1.5, sound["duration"], delta=0.1)
|
||||||
|
self.assertEqual(payload, b"".join(self.client.get(sound["audio"]).streaming_content))
|
||||||
|
self.assertEqual(sound, self.client.get(f"/api/sounds/{sound['id']}").json())
|
||||||
|
self.assertEqual([sound], self.client.get("/api/sounds").json()["sounds"])
|
||||||
|
self.assertEqual(0, Source.objects.count())
|
||||||
|
|
||||||
|
again = self.client.post("/api/sounds", {
|
||||||
|
"file": SimpleUploadedFile("again.mp3", payload, content_type="audio/mpeg")})
|
||||||
|
self.assertEqual(200, again.status_code)
|
||||||
|
self.assertEqual(1, Sound.objects.count())
|
||||||
|
|
||||||
|
def test_a_file_without_audio_is_not_a_sound(self):
|
||||||
|
refused = self.client.post("/api/sounds", {
|
||||||
|
"file": SimpleUploadedFile("notes.txt", b"not audio", content_type="text/plain")})
|
||||||
|
self.assertEqual(400, refused.status_code)
|
||||||
|
|
||||||
def test_uploaded_video_extracts_to_reopenable_footage(self):
|
def test_uploaded_video_extracts_to_reopenable_footage(self):
|
||||||
with tempfile.TemporaryDirectory() as directory:
|
with tempfile.TemporaryDirectory() as directory:
|
||||||
path = Path(directory) / "four-frames.mp4"
|
path = Path(directory) / "four-frames.mp4"
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,8 @@ urlpatterns = [
|
||||||
path("logout", views.logout),
|
path("logout", views.logout),
|
||||||
path("detector", views.detector),
|
path("detector", views.detector),
|
||||||
path("sources", views.sources),
|
path("sources", views.sources),
|
||||||
|
path("sounds", views.sounds),
|
||||||
|
path("sounds/<uuid:sound_id>", views.sound_detail),
|
||||||
path("extractions", views.extractions),
|
path("extractions", views.extractions),
|
||||||
path("extractions/<str:key>", views.extraction_detail),
|
path("extractions/<str:key>", views.extraction_detail),
|
||||||
path("footage", views.footage_list),
|
path("footage", views.footage_list),
|
||||||
|
|
|
||||||
|
|
@ -43,7 +43,7 @@ from django.views.decorators.http import require_http_methods
|
||||||
|
|
||||||
from . import blobs, extraction
|
from . import blobs, extraction
|
||||||
from .consumers import broadcast
|
from .consumers import broadcast
|
||||||
from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Leaf, Project, Revision, Source
|
from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Leaf, Project, Revision, Sound, Source
|
||||||
|
|
||||||
KEY_LENGTH = 71 # "sha256:" + 64 hex
|
KEY_LENGTH = 71 # "sha256:" + 64 hex
|
||||||
|
|
||||||
|
|
@ -225,6 +225,41 @@ def sources(request):
|
||||||
return JsonResponse({"error": str(exc)}, status=400)
|
return JsonResponse({"error": str(exc)}, status=400)
|
||||||
|
|
||||||
|
|
||||||
|
def _sound_json(row):
|
||||||
|
return {"id": str(row.id), "label": row.filename, "duration": row.duration,
|
||||||
|
"audio": f"/blob/{row.blob_id}"}
|
||||||
|
|
||||||
|
|
||||||
|
@require_http_methods(["GET", "POST"])
|
||||||
|
def sounds(request):
|
||||||
|
if request.method == "GET":
|
||||||
|
return JsonResponse({"sounds": [_sound_json(row)
|
||||||
|
for row in Sound.objects.order_by("-created")]})
|
||||||
|
upload = request.FILES.get("file")
|
||||||
|
if upload is None:
|
||||||
|
return JsonResponse({"error": "upload a sound as the file field"}, status=400)
|
||||||
|
try:
|
||||||
|
digest, size = blobs.write_stream(upload.chunks())
|
||||||
|
duration = extraction.probe_audio(blobs.path_for(digest))
|
||||||
|
blob, _ = Blob.objects.get_or_create(
|
||||||
|
digest=digest, defaults={"size": size,
|
||||||
|
"media_type": upload.content_type or "audio/mpeg"})
|
||||||
|
row, created = Sound.objects.get_or_create(
|
||||||
|
blob=blob, defaults={"filename": Path(upload.name).name[:255],
|
||||||
|
"duration": duration})
|
||||||
|
return JsonResponse(_sound_json(row), status=201 if created else 200)
|
||||||
|
except (ValueError, OSError) as exc:
|
||||||
|
return JsonResponse({"error": str(exc)}, status=400)
|
||||||
|
|
||||||
|
|
||||||
|
@require_http_methods(["GET"])
|
||||||
|
def sound_detail(request, sound_id):
|
||||||
|
try:
|
||||||
|
return JsonResponse(_sound_json(Sound.objects.get(id=sound_id)))
|
||||||
|
except Sound.DoesNotExist:
|
||||||
|
return JsonResponse({"error": "no such sound"}, status=404)
|
||||||
|
|
||||||
|
|
||||||
def _extraction_json(row):
|
def _extraction_json(row):
|
||||||
return {"key": row.key, "source": str(row.source_id), "state": row.state,
|
return {"key": row.key, "source": str(row.source_id), "state": row.state,
|
||||||
"progress": row.progress, "error": row.error,
|
"progress": row.progress, "error": row.error,
|
||||||
|
|
|
||||||
|
|
@ -78,7 +78,8 @@ candidate poses so stage cuts can still select any of them.
|
||||||
| --- | --- | --- |
|
| --- | --- | --- |
|
||||||
| Source frames and timestamps | Footage/analysis | Constant-rate frame indexing exists; variable timestamps remain future work |
|
| Source frames and timestamps | Footage/analysis | Constant-rate frame indexing exists; variable timestamps remain future work |
|
||||||
| Head anchor map | `:head` node | Implemented, stored with the node |
|
| Head anchor map | `:head` node | Implemented, stored with the node |
|
||||||
| Tracing cel starts and photo address | Authored cel | Separate future work |
|
| Trace frames (photo address) and origin | Face symbol's `:head` `:trace`, written through `:anchors` | Implemented, see `domain/trace` |
|
||||||
|
| Showing the tracing photo, and its opacity | Face instance's `:underlay` | Implemented; a drawing aid, not keyed |
|
||||||
| Generated picture-rate proposal and closure protection | Roto clip/symbol | Generated-only picture sampling exists; closure protection remains future work |
|
| Generated picture-rate proposal and closure protection | Roto clip/symbol | Generated-only picture sampling exists; closure protection remains future work |
|
||||||
| Stage pose cuts | Symbol instance | Implemented, stored with the instance |
|
| Stage pose cuts | Symbol instance | Implemented, stored with the instance |
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -55,26 +55,36 @@
|
||||||
(js/URL.createObjectURL
|
(js/URL.createObjectURL
|
||||||
(js/Blob. #js [(wav-bytes buffer)] #js {:type "audio/wav"})))
|
(js/Blob. #js [(wav-bytes buffer)] #js {:type "audio/wav"})))
|
||||||
|
|
||||||
(defn- source! [footage-id]
|
(defn- fetch-ok! [url what]
|
||||||
(-> (js/fetch (str "/api/footage/" footage-id))
|
(-> (js/fetch url)
|
||||||
(.then (fn [response]
|
(.then (fn [response]
|
||||||
(when-not (.-ok response)
|
(when-not (.-ok response)
|
||||||
(throw (ex-info "audio track's footage is missing"
|
(throw (ex-info (str "audio track's " what " is missing")
|
||||||
{:footage footage-id :status (.-status response)})))
|
{:url url :status (.-status response)})))
|
||||||
(.json response)))
|
response))))
|
||||||
(.then (fn [^js manifest]
|
|
||||||
(-> (js/fetch (.-audio manifest))
|
(defn- decode-bytes! [bytes]
|
||||||
(.then (fn [response]
|
(.decodeAudioData (js/OfflineAudioContext. 1 1 44100) bytes))
|
||||||
(when-not (.-ok response)
|
|
||||||
(throw (ex-info "audio track's blob is missing"
|
(defn- source!
|
||||||
{:footage footage-id :status (.-status response)})))
|
"Promise of `[source {:buffer :fps}]` for an audio node's `:source`. Footage
|
||||||
(.arrayBuffer response)))
|
counts its frames at its own rate; a sound file has no frames of its own, so
|
||||||
(.then (fn [bytes]
|
its `:fps` is nil and it counts in the document's."
|
||||||
(let [decoder (js/OfflineAudioContext. 1 1 44100)]
|
[{:keys [footage sound] :as source}]
|
||||||
(-> (.decodeAudioData decoder bytes)
|
(if sound
|
||||||
(.then (fn [buffer]
|
(-> (fetch-ok! (str "/api/sounds/" sound) "sound")
|
||||||
[footage-id {:buffer buffer
|
(.then #(.json %))
|
||||||
:fps (.-fps manifest)}])))))))))))
|
(.then #(fetch-ok! (.-audio %) "blob"))
|
||||||
|
(.then #(.arrayBuffer %))
|
||||||
|
(.then decode-bytes!)
|
||||||
|
(.then (fn [buffer] [source {:buffer buffer}])))
|
||||||
|
(-> (fetch-ok! (str "/api/footage/" footage) "footage")
|
||||||
|
(.then #(.json %))
|
||||||
|
(.then (fn [^js manifest]
|
||||||
|
(-> (fetch-ok! (.-audio manifest) "blob")
|
||||||
|
(.then #(.arrayBuffer %))
|
||||||
|
(.then decode-bytes!)
|
||||||
|
(.then (fn [buffer] [source {:buffer buffer :fps (.-fps manifest)}]))))))))
|
||||||
|
|
||||||
(defn- automate! [^js param channel start end fps factor default store]
|
(defn- automate! [^js param channel start end fps factor default store]
|
||||||
(let [channel (or channel (ch/framed default))]
|
(let [channel (or channel (ch/framed default))]
|
||||||
|
|
@ -107,7 +117,7 @@
|
||||||
(let [[start end] (or (node/placed-span track) [0 frames])
|
(let [[start end] (or (node/placed-span track) [0 frames])
|
||||||
start (max 0 start)
|
start (max 0 start)
|
||||||
end (min frames end)
|
end (min frames end)
|
||||||
{:keys [buffer fps]} (get sources (get-in track [:source :footage]))
|
{:keys [buffer fps] :or {fps (:fps document)}} (get sources (:source track))
|
||||||
sound (.createBufferSource output)
|
sound (.createBufferSource output)
|
||||||
gain (.createGain output)
|
gain (.createGain output)
|
||||||
pan (.createStereoPanner output)]
|
pan (.createStereoPanner output)]
|
||||||
|
|
@ -143,7 +153,7 @@
|
||||||
(if (empty? tracks)
|
(if (empty? tracks)
|
||||||
(js/Promise.resolve nil)
|
(js/Promise.resolve nil)
|
||||||
(-> (js/Promise.all
|
(-> (js/Promise.all
|
||||||
(into-array (map source! (distinct (map #(get-in % [:source :footage]) tracks)))))
|
(into-array (map source! (distinct (map :source tracks)))))
|
||||||
(.then (fn [pairs] (render! document sid (into {} (array-seq pairs)) store))))))))
|
(.then (fn [pairs] (render! document sid (into {} (array-seq pairs)) store))))))))
|
||||||
|
|
||||||
(defn decode!
|
(defn decode!
|
||||||
|
|
@ -156,8 +166,7 @@
|
||||||
(throw (ex-info "the clip's audio did not load"
|
(throw (ex-info "the clip's audio did not load"
|
||||||
{:url url :status (.-status response)})))
|
{:url url :status (.-status response)})))
|
||||||
(.arrayBuffer response)))
|
(.arrayBuffer response)))
|
||||||
(.then (fn [bytes]
|
(.then decode-bytes!)))
|
||||||
(.decodeAudioData (js/OfflineAudioContext. 1 1 44100) bytes)))))
|
|
||||||
|
|
||||||
(defn mix!
|
(defn mix!
|
||||||
"Promise of a mixed WAV URL for symbol `sid`, or the original URL when it has
|
"Promise of a mixed WAV URL for symbol `sid`, or the original URL when it has
|
||||||
|
|
|
||||||
|
|
@ -95,4 +95,4 @@
|
||||||
|
|
||||||
(def locked
|
(def locked
|
||||||
"The same blocks, with `:head` held at measured frame zero."
|
"The same blocks, with `:head` held at measured frame zero."
|
||||||
(delay (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen)))
|
(delay (freeze/head-mode {:trace {:origin :start}} @frozen)))
|
||||||
|
|
|
||||||
|
|
@ -166,7 +166,14 @@
|
||||||
|
|
||||||
Any symbol can be resolved and none is the default: the frame space is the
|
Any symbol can be resolved and none is the default: the frame space is the
|
||||||
resolved symbol's own `:frames`, and nested instances inside it still resolve,
|
resolved symbol's own `:frames`, and nested instances inside it still resolve,
|
||||||
because this is the function that knows how to do that."
|
because this is the function that knows how to do that.
|
||||||
|
|
||||||
|
It answers `symbol/world-of` and `symbol/frame-of` for a ROW PATH — the ids
|
||||||
|
from `sid` down through instances, as a timeline row names a node — as of the
|
||||||
|
frame it last resolved: the matrix into `sid`'s coordinates, and the node's
|
||||||
|
own frame. Nil for a node that was not on that frame. It is how something
|
||||||
|
drawn beside the picture, like a tracing photo, rides a node inside it without
|
||||||
|
resolving anything a second time."
|
||||||
([clip store palette sid] (resolver clip store palette sid nil))
|
([clip store palette sid] (resolver clip store palette sid nil))
|
||||||
([clip store palette sid {:keys [picture-fps] :as opts}]
|
([clip store palette sid {:keys [picture-fps] :as opts}]
|
||||||
(letfn [(build [sid chain pose-tracks]
|
(letfn [(build [sid chain pose-tracks]
|
||||||
|
|
@ -182,27 +189,47 @@
|
||||||
children (into {}
|
children (into {}
|
||||||
(for [[id n] nodes :when (= :instance (:kind n))]
|
(for [[id n] nodes :when (= :instance (:kind n))]
|
||||||
[id (build (:of n) (conj chain sid)
|
[id (build (:of n) (conj chain sid)
|
||||||
(get-in n [:playback :tracks]))]))]
|
(get-in n [:playback :tracks]))]))
|
||||||
(fn [f]
|
;; The instances that were on the last frame. Their resolvers
|
||||||
(let [by-id (into {} (map (juxt :node identity)) (own f))]
|
;; still hold the frame before whenever they were not.
|
||||||
(into []
|
entered (volatile! #{})
|
||||||
(mapcat
|
step (fn [f]
|
||||||
(fn [id]
|
(vreset! entered #{})
|
||||||
(let [n (get nodes id)]
|
(let [by-id (into {} (map (juxt :node identity)) (own f))]
|
||||||
(if (= :instance (:kind n))
|
(into []
|
||||||
(let [m (symbol/world-of own id)
|
(mapcat
|
||||||
local (symbol/frame-of own id)
|
(fn [id]
|
||||||
target (symbol clip (:of n))
|
(let [n (get nodes id)]
|
||||||
length (:frames target)
|
(if (= :instance (:kind n))
|
||||||
frame (when (and m (number? local))
|
(let [m (symbol/world-of own id)
|
||||||
(if (get-in n [:time :loop?])
|
local (symbol/frame-of own id)
|
||||||
(mod local length)
|
target (symbol clip (:of n))
|
||||||
local))]
|
length (:frames target)
|
||||||
(if (and frame (<= 0 frame) (< frame length))
|
frame (when (and m (number? local))
|
||||||
(map #(transform-op % m [id]) ((get children id) frame))
|
(if (get-in n [:time :loop?])
|
||||||
[]))
|
(mod local length)
|
||||||
(when-let [op (get by-id id)] [op]))))
|
local))]
|
||||||
ids))))))]
|
(if (and frame (<= 0 frame) (< frame length))
|
||||||
|
(do (vswap! entered conj id)
|
||||||
|
(map #(transform-op % m [id]) ((get children id) frame)))
|
||||||
|
[]))
|
||||||
|
(when-let [op (get by-id id)] [op]))))
|
||||||
|
ids))))]
|
||||||
|
(reify
|
||||||
|
IFn
|
||||||
|
(-invoke [_ f] (step f))
|
||||||
|
symbol/IResolver
|
||||||
|
(world-of [_ [id & more]]
|
||||||
|
(if more
|
||||||
|
(when-let [w (and (contains? @entered id)
|
||||||
|
(symbol/world-of (get children id) (vec more)))]
|
||||||
|
(node/mul! (node/mat) (symbol/world-of own id) w))
|
||||||
|
(symbol/world-of own id)))
|
||||||
|
(frame-of [_ [id & more]]
|
||||||
|
(if more
|
||||||
|
(when (contains? @entered id)
|
||||||
|
(symbol/frame-of (get children id) (vec more)))
|
||||||
|
(symbol/frame-of own id))))))]
|
||||||
(build sid [] nil))))
|
(build sid [] nil))))
|
||||||
|
|
||||||
(defn center
|
(defn center
|
||||||
|
|
@ -280,6 +307,27 @@
|
||||||
:value (if point (mapv - point middle) [0 0])}
|
:value (if point (mapv - point middle) [0 0])}
|
||||||
[:xform :anchor] {:animated? false :value middle}}})))))
|
[:xform :anchor] {:animated? false :value middle}}})))))
|
||||||
|
|
||||||
|
(defn place-sound
|
||||||
|
"An audio node playing `source` — `{:sound id}`, an uploaded file, or
|
||||||
|
`{:footage id}`, a video's own sound — inside symbol `host` from `frame` of it.
|
||||||
|
Timed as an instance is: `:at frame`, its span `length` of its OWN frames, and
|
||||||
|
`rate` of those to one of `host`'s, which is what keeps a 30fps video's sound
|
||||||
|
its own length in a 12fps project. Nothing else: a sound is not in the picture."
|
||||||
|
[clip host source label length rate frame uuid]
|
||||||
|
(let [end (frames clip host)]
|
||||||
|
(if (or (nil? end) (nil? frame) (neg? frame) (>= frame end))
|
||||||
|
clip
|
||||||
|
(update-symbol
|
||||||
|
clip host assoc-in [:nodes uuid]
|
||||||
|
{:id uuid
|
||||||
|
:name label
|
||||||
|
:kind :audio
|
||||||
|
:parent nil
|
||||||
|
:z (str "z" (js/Date.now) "-sound")
|
||||||
|
:source source
|
||||||
|
:span [0 (max 1 length)]
|
||||||
|
:time {:mode :map :at frame :rate rate}}))))
|
||||||
|
|
||||||
(defn fresh-id
|
(defn fresh-id
|
||||||
"The first `:symbol-N` the clip does not already hold. Readable because an id
|
"The first `:symbol-N` the clip does not already hold. Readable because an id
|
||||||
shows up in saved leaf paths, and deterministic because this namespace is pure."
|
shows up in saved leaf paths, and deterministic because this namespace is pure."
|
||||||
|
|
|
||||||
77
frontend/src/arthur/domain/gesture.cljs
Normal file
77
frontend/src/arthur/domain/gesture.cljs
Normal file
|
|
@ -0,0 +1,77 @@
|
||||||
|
(ns arthur.domain.gesture
|
||||||
|
"Moving, turning and scaling a node by hand on the stage, as channel values.
|
||||||
|
|
||||||
|
A drag says where the pointer went in stage pixels; this says what that makes
|
||||||
|
the node's `[:xform :pos]`, `[:xform :rot]` or `[:xform :scale]`, given its
|
||||||
|
`nest/placement`. Whatever is above the node — instances, parents, a `:pinv` —
|
||||||
|
is in the placement's matrices, so a shape five symbols down moves under the
|
||||||
|
pointer like one on top.
|
||||||
|
|
||||||
|
THE KEYING RULE IS `node/set-channel`, the inspector's: a channel with keys
|
||||||
|
gets one on the node's own frame, and one without has its one value changed.
|
||||||
|
After Effects' stopwatch — there is no mode to be in, and nothing snaps back
|
||||||
|
on the next frame as an unkeyed change does in Blender."
|
||||||
|
(:require [arthur.domain.channel :as ch]
|
||||||
|
[arthur.domain.node :as node]))
|
||||||
|
|
||||||
|
(defn values
|
||||||
|
"Node `n`'s transform on its own frame `f`, as vectors."
|
||||||
|
[n f]
|
||||||
|
(let [at #(ch/value-at (get (node/channels n) [:xform %]) f)
|
||||||
|
xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])]
|
||||||
|
{:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)}))
|
||||||
|
|
||||||
|
(defn refusal
|
||||||
|
"Why node `n`'s transform cannot be set by hand, or nil when it can. A
|
||||||
|
measured transform is regenerated from the footage, and writing a value over
|
||||||
|
it would throw the measurement away."
|
||||||
|
[n]
|
||||||
|
(cond
|
||||||
|
(some #(let [c (get-in n [:channels [:xform %]])] (or (:dense c) (:generated c)))
|
||||||
|
[:pos :rot :scale])
|
||||||
|
"its transform is measured — place the instance it is in"))
|
||||||
|
|
||||||
|
(defn- through [m [x y]]
|
||||||
|
(let [out (js/Float64Array. 2)]
|
||||||
|
(node/apply-pt! out 0 m x y)
|
||||||
|
[(aget out 0) (aget out 1)]))
|
||||||
|
|
||||||
|
(defn move
|
||||||
|
"The node's position with its pivot carried from stage point `p0` to `p1`."
|
||||||
|
[{:keys [parent]} {:keys [pos]} p0 p1]
|
||||||
|
(when-let [inv (node/invert parent)]
|
||||||
|
{[:xform :pos] (mapv + pos (mapv - (through inv p1) (through inv p0)))}))
|
||||||
|
|
||||||
|
(defn angle
|
||||||
|
"The angle of stage point `p` about the node's pivot, in the space its
|
||||||
|
rotation is in."
|
||||||
|
[{:keys [parent]} {:keys [pos anchor]} p]
|
||||||
|
(when-let [inv (node/invert parent)]
|
||||||
|
(let [[x y] (mapv - (through inv p) (mapv + pos anchor))]
|
||||||
|
(js/Math.atan2 y x))))
|
||||||
|
|
||||||
|
(defn turn
|
||||||
|
"The node's rotation, turned by `da` radians."
|
||||||
|
[{:keys [rot]} da]
|
||||||
|
{[:xform :rot] (+ rot da)})
|
||||||
|
|
||||||
|
(defn scale
|
||||||
|
"The node's scale with the point under stage `p0` taken to `p1`, about its
|
||||||
|
pivot, along its own axes — or by the same factor on both when `uniform?`."
|
||||||
|
[{:keys [world]} {:keys [anchor] s :scale} p0 p1 uniform?]
|
||||||
|
(when-let [inv (node/invert world)]
|
||||||
|
(let [a (mapv - (through inv p0) anchor)
|
||||||
|
b (mapv - (through inv p1) anchor)
|
||||||
|
k (fn [a b] (if (< (js/Math.abs a) 1e-6) 1 (/ b a)))
|
||||||
|
r (if uniform?
|
||||||
|
(let [aa (reduce + (map * a a))]
|
||||||
|
(if (< aa 1e-9) 1 (/ (reduce + (map * a b)) aa)))
|
||||||
|
nil)]
|
||||||
|
{[:xform :scale] (if r (mapv #(* r %) s) (mapv * s (map k a b)))})))
|
||||||
|
|
||||||
|
(defn apply-values
|
||||||
|
"Clip with channel values `vs`, `{path value}`, written into node `id` of
|
||||||
|
symbol `sid` on the node's own frame `f`, by the keying rule above."
|
||||||
|
[clip sid id f vs]
|
||||||
|
(update-in clip [:symbols sid :nodes id]
|
||||||
|
#(reduce-kv (fn [n path v] (node/set-channel n path f v)) % vs)))
|
||||||
|
|
@ -45,8 +45,8 @@
|
||||||
WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are
|
WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are
|
||||||
not authored: they are written together by a freeze and replaced together by a
|
not authored: they are written together by a freeze and replaced together by a
|
||||||
re-freeze, and `head-mode` exposes them through `:channels`. The optional
|
re-freeze, and `head-mode` exposes them through `:channels`. The optional
|
||||||
`:anchors` map on the head node chooses which measured frame those channels
|
`:trace` on the head node chooses which measured frame those channels read.
|
||||||
read. A leaf per measured
|
A leaf per measured
|
||||||
channel would offer a write nobody can make. The authored channels beside them
|
channel would offer a write nobody can make. The authored channels beside them
|
||||||
are one leaf each, because a hand writes one at a time.
|
are one leaf each, because a hand writes one at a time.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -23,16 +23,6 @@
|
||||||
[arthur.domain.palette :as pal]
|
[arthur.domain.palette :as pal]
|
||||||
[arthur.domain.symbol :as symbol]))
|
[arthur.domain.symbol :as symbol]))
|
||||||
|
|
||||||
(defn invert
|
|
||||||
"The inverse of a 2x3 affine, or nil when it has none — an instance scaled to
|
|
||||||
nothing has no inside to draw into."
|
|
||||||
[^js m]
|
|
||||||
(let [[a b c d e f] (array-seq m)
|
|
||||||
det (- (* a d) (* b c))]
|
|
||||||
(when-not (zero? det)
|
|
||||||
(js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det)
|
|
||||||
(/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)]))))
|
|
||||||
|
|
||||||
(defn- resolved
|
(defn- resolved
|
||||||
"Node `id` of symbol `sid`, resolved at `frame`: the resolver, which then
|
"Node `id` of symbol `sid`, resolved at `frame`: the resolver, which then
|
||||||
answers `symbol/world-of` and `symbol/frame-of` for it on that frame.
|
answers `symbol/world-of` and `symbol/frame-of` for it on that frame.
|
||||||
|
|
@ -82,13 +72,35 @@
|
||||||
{:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}}
|
{:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}}
|
||||||
path))
|
path))
|
||||||
|
|
||||||
|
(defn placement
|
||||||
|
"Where the node at row path `path` is, from symbol `sid` showing frame `f`, as
|
||||||
|
a transform would change it: `{:sid :id :frame :parent :world}` — the symbol it
|
||||||
|
lives in, its own frame, the matrix from the space its `[:xform :pos]` is in to
|
||||||
|
`sid`'s, and the one from its own coordinates. Nil when it is not on screen.
|
||||||
|
|
||||||
|
`:parent` is everything above the node's own transform, `world = parent ·
|
||||||
|
local`: its symbol's way to the stage, its parents there, and its `:pinv`."
|
||||||
|
[clip store sid path f]
|
||||||
|
(when-let [{:keys [sid frame matrix]} (inside clip store sid (pop path) f)]
|
||||||
|
(let [id (peek path)
|
||||||
|
n (get-in clip [:symbols sid :nodes id])
|
||||||
|
r (when n (resolved clip store sid frame id))
|
||||||
|
w (when r (symbol/world-of r id))]
|
||||||
|
(when w
|
||||||
|
{:sid sid :id id
|
||||||
|
:frame (js/Math.floor (symbol/frame-of r id))
|
||||||
|
:parent (reduce #(node/mul! (node/mat) %1 %2) matrix
|
||||||
|
(keep identity [(some->> (:parent n) (symbol/world-of r))
|
||||||
|
(node/pinv n)]))
|
||||||
|
:world (node/mul! (node/mat) matrix w)}))))
|
||||||
|
|
||||||
(defn drawn-inside
|
(defn drawn-inside
|
||||||
"Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the
|
"Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the
|
||||||
symbol `path` leads to, so a shape added there lands exactly where it was drawn.
|
symbol `path` leads to, so a shape added there lands exactly where it was drawn.
|
||||||
`{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside."
|
`{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside."
|
||||||
[clip store sid path f pts]
|
[clip store sid path f pts]
|
||||||
(when-let [{:keys [matrix] :as at} (inside clip store sid path f)]
|
(when-let [{:keys [matrix] :as at} (inside clip store sid path f)]
|
||||||
(when-let [inv (invert matrix)]
|
(when-let [inv (node/invert matrix)]
|
||||||
(let [out (js/Float64Array. 2)]
|
(let [out (js/Float64Array. 2)]
|
||||||
(assoc (select-keys at [:sid :frame])
|
(assoc (select-keys at [:sid :frame])
|
||||||
:pts (into [] (mapcat (fn [[x y]]
|
:pts (into [] (mapcat (fn [[x y]]
|
||||||
|
|
@ -221,7 +233,7 @@
|
||||||
there (inside clip store open to f)
|
there (inside clip store open to f)
|
||||||
a (:time here)
|
a (:time here)
|
||||||
b (:time there)
|
b (:time there)
|
||||||
inv (some-> there :matrix invert)]
|
inv (some-> there :matrix node/invert)]
|
||||||
(cond
|
(cond
|
||||||
(nil? (get-in clip [:symbols (:sid here) :nodes (peek from)]))
|
(nil? (get-in clip [:symbols (:sid here) :nodes (peek from)]))
|
||||||
{:refused "nothing to move"}
|
{:refused "nothing to move"}
|
||||||
|
|
|
||||||
|
|
@ -46,7 +46,9 @@
|
||||||
(let [base (into #{[:vis]} xform-paths)]
|
(let [base (into #{[:vis]} xform-paths)]
|
||||||
{:group base
|
{:group base
|
||||||
:instance base
|
:instance base
|
||||||
:audio (into base [[:audio :gain] [:audio :pan] [:audio :rate]])
|
;; A sound is not in the picture: no transform, no visibility. After
|
||||||
|
;; Effects' audio-only layer has no Transform group for the same reason.
|
||||||
|
:audio #{[:audio :gain] [:audio :pan] [:audio :rate]}
|
||||||
:poly (into base [[:geom :pts] [:style :color]])
|
:poly (into base [[:geom :pts] [:style :color]])
|
||||||
;; A disc's radius is framed in practice — iris size is a knob, not a
|
;; 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.
|
;; performance — but it is a channel like any other so it can be keyed.
|
||||||
|
|
@ -65,10 +67,19 @@
|
||||||
[:xform :anchor] (ch/framed [0.0 0.0])
|
[:xform :anchor] (ch/framed [0.0 0.0])
|
||||||
[:vis] (ch/framed true)})
|
[:vis] (ch/framed true)})
|
||||||
|
|
||||||
|
(def audio-defaults
|
||||||
|
"Unity gain, centred, at its own speed."
|
||||||
|
{[:audio :gain] (ch/framed 1.0)
|
||||||
|
[:audio :pan] (ch/framed 0.0)
|
||||||
|
[:audio :rate] (ch/framed 1.0)})
|
||||||
|
|
||||||
|
(defn defaults-of [n]
|
||||||
|
(if (= :audio (:kind n)) audio-defaults defaults))
|
||||||
|
|
||||||
(defn channels
|
(defn channels
|
||||||
"The node's channels with the transform defaults filled in."
|
"The node's channels with its kind's defaults filled in."
|
||||||
[n]
|
[n]
|
||||||
(merge defaults (:channels n)))
|
(merge (defaults-of n) (:channels n)))
|
||||||
|
|
||||||
(defn set-channel
|
(defn set-channel
|
||||||
"Write `v` into channel `path`: a key on the node's own frame `f` when the
|
"Write `v` into channel `path`: a key on the node's own frame `f` when the
|
||||||
|
|
@ -94,6 +105,16 @@
|
||||||
(:segments c) (update :segments dissoc f))
|
(:segments c) (update :segments dissoc f))
|
||||||
:else (ch/framed v)))))
|
:else (ch/framed v)))))
|
||||||
|
|
||||||
|
(defn set-segment-interp
|
||||||
|
"Choose how channel `path`'s key at `left` leads to the next one: `:hold` cuts
|
||||||
|
there, `:linear` tweens. The same for a drawing's points as for a transform —
|
||||||
|
only a gap that exists, between a key and a later one, can be chosen."
|
||||||
|
[n path left interp]
|
||||||
|
(let [ks (:keys (get (channels n) path))]
|
||||||
|
(if (and (contains? ks left) (some #(< left %) (keys ks)) (#{:hold :linear} interp))
|
||||||
|
(assoc-in n [:channels path :segments left] interp)
|
||||||
|
n)))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; time maps
|
;; time maps
|
||||||
;;
|
;;
|
||||||
|
|
@ -284,6 +305,16 @@
|
||||||
pinv-m (mul! dest pinv-m local)
|
pinv-m (mul! dest pinv-m local)
|
||||||
:else (doto dest (.set local))))
|
:else (doto dest (.set local))))
|
||||||
|
|
||||||
|
(defn invert
|
||||||
|
"The inverse of a 2x3 affine, or nil when it has none — a node scaled to
|
||||||
|
nothing has no inside to draw into."
|
||||||
|
[^js m]
|
||||||
|
(let [[a b c d e f] (array-seq m)
|
||||||
|
det (- (* a d) (* b c))]
|
||||||
|
(when-not (zero? det)
|
||||||
|
(js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det)
|
||||||
|
(/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)]))))
|
||||||
|
|
||||||
(defn apply-pt!
|
(defn apply-pt!
|
||||||
"out[2i], out[2i+1] := m · (x, y)."
|
"out[2i], out[2i+1] := m · (x, y)."
|
||||||
[^js out i ^js m x y]
|
[^js out i ^js m x y]
|
||||||
|
|
@ -322,8 +353,8 @@
|
||||||
(conj (str ":kind " k " is in the vocabulary but not implemented"))
|
(conj (str ":kind " k " is in the vocabulary but not implemented"))
|
||||||
|
|
||||||
(and (= k :instance) (nil? (:of n))) (conj "an instance needs :of")
|
(and (= k :instance) (nil? (:of n))) (conj "an instance needs :of")
|
||||||
(and (= k :audio) (nil? (get-in n [:source :footage])))
|
(and (= k :audio) (not (some (:source n) [:footage :sound])))
|
||||||
(conj "an audio instance needs :source :footage")
|
(conj "an audio node needs a :source :footage or :sound")
|
||||||
(and (some? (get-in n [:time :rate]))
|
(and (some? (get-in n [:time :rate]))
|
||||||
(not (pos? (get-in n [:time :rate]))))
|
(not (pos? (get-in n [:time :rate]))))
|
||||||
(conj ":time :rate must be positive")
|
(conj ":time :rate must be positive")
|
||||||
|
|
|
||||||
|
|
@ -26,7 +26,12 @@
|
||||||
:kind :poly :paint? true :parent nil :z z
|
:kind :poly :paint? true :parent nil :z z
|
||||||
:span [frame end]
|
:span [frame end]
|
||||||
:channels {geometry (channel/keyed {frame points})
|
:channels {geometry (channel/keyed {frame points})
|
||||||
[:style :color] (channel/framed color)}})
|
[:style :color] (channel/framed color)
|
||||||
|
;; Turned and scaled about its middle, as a placed
|
||||||
|
;; symbol is: set once here and never followed.
|
||||||
|
[:xform :anchor]
|
||||||
|
(channel/framed (mapv (fn [vs] (/ (+ (apply min vs) (apply max vs)) 2))
|
||||||
|
[(take-nth 2 points) (take-nth 2 (rest points))]))}})
|
||||||
clip)))
|
clip)))
|
||||||
|
|
||||||
(defn add-key [clip sid id frame]
|
(defn add-key [clip sid id frame]
|
||||||
|
|
@ -46,13 +51,3 @@
|
||||||
(if (and points (< (inc i) (count points)))
|
(if (and points (< (inc i) (count points)))
|
||||||
(assoc-in clip path (-> points (assoc i x) (assoc (inc i) y)))
|
(assoc-in clip path (-> points (assoc i x) (assoc (inc i) y)))
|
||||||
clip)))
|
clip)))
|
||||||
|
|
||||||
(defn set-segment-interp [clip sid id key-frame interp]
|
|
||||||
(let [node (get-in clip [:symbols sid :nodes id])
|
|
||||||
keys (get-in node [:channels geometry :keys])]
|
|
||||||
(if (and (:paint? node) (contains? keys key-frame)
|
|
||||||
(some #(< key-frame %) (clojure.core/keys keys))
|
|
||||||
(#{:hold :linear} interp))
|
|
||||||
(assoc-in clip [:symbols sid :nodes id :channels geometry
|
|
||||||
:segments key-frame] interp)
|
|
||||||
clip)))
|
|
||||||
|
|
|
||||||
109
frontend/src/arthur/domain/pick.cljs
Normal file
109
frontend/src/arthur/domain/pick.cljs
Normal file
|
|
@ -0,0 +1,109 @@
|
||||||
|
(ns arthur.domain.pick
|
||||||
|
"What is under the pointer on the stage, and which row a click on it selects.
|
||||||
|
|
||||||
|
THE OPS ALREADY SAY. The stage draws a flat list of ops, and each op's `:node`
|
||||||
|
is the row path of what drew it — the instances down to it and its own id — so
|
||||||
|
hit-testing is a walk of the list, topmost first, and needs nothing resolved.
|
||||||
|
|
||||||
|
WHICH LEVEL a click selects is Figma's and Illustrator's rule, and Flash's
|
||||||
|
without its edit mode: a click selects the thing in the open symbol, a
|
||||||
|
double-click goes one level into what is selected, ⌘-click goes straight to the
|
||||||
|
shape itself. A click inside what is selected keeps it, so a deep selection can
|
||||||
|
be dragged; one elsewhere selects at the same depth, beside it."
|
||||||
|
(:require [arthur.domain.channel :as ch]
|
||||||
|
[arthur.domain.clip :as clip]
|
||||||
|
[arthur.domain.node :as node]
|
||||||
|
[arthur.domain.palette :as pal]))
|
||||||
|
|
||||||
|
(def ^:private slop
|
||||||
|
"Stage pixels a click may miss by. The shapes here are a few pixels across."
|
||||||
|
2)
|
||||||
|
|
||||||
|
(defn- path-of [op]
|
||||||
|
(let [n (:node op)] (if (vector? n) n [n])))
|
||||||
|
|
||||||
|
(defn- near-segment? [x y ax ay bx by]
|
||||||
|
(let [dx (- bx ax) dy (- by ay)
|
||||||
|
l2 (+ (* dx dx) (* dy dy))
|
||||||
|
t (if (zero? l2) 0 (-> (/ (+ (* (- x ax) dx) (* (- y ay) dy)) l2) (max 0) (min 1)))
|
||||||
|
ex (- x (+ ax (* t dx)))
|
||||||
|
ey (- y (+ ay (* t dy)))]
|
||||||
|
(<= (+ (* ex ex) (* ey ey)) (* slop slop))))
|
||||||
|
|
||||||
|
(defn- on-poly? [^js pts n x y]
|
||||||
|
(let [px #(aget pts (* 2 (mod % n)))
|
||||||
|
py #(aget pts (inc (* 2 (mod % n))))]
|
||||||
|
(or (odd? (count (filter (fn [i]
|
||||||
|
(let [ay (py i) by (py (inc i))]
|
||||||
|
(and (not= (> ay y) (> by y))
|
||||||
|
(< x (+ (px i) (/ (* (- y ay) (- (px (inc i)) (px i)))
|
||||||
|
(- by ay)))))))
|
||||||
|
(range n))))
|
||||||
|
(some #(near-segment? x y (px %) (py %) (px (inc %)) (py (inc %))) (range n)))))
|
||||||
|
|
||||||
|
(defn- on? [{:keys [kind pts n cx cy r size]} x y]
|
||||||
|
(case kind
|
||||||
|
:poly (on-poly? pts n x y)
|
||||||
|
:disc (<= (js/Math.hypot (- x cx) (- y cy)) (+ r slop))
|
||||||
|
:rect (let [h (+ slop (/ size 2))]
|
||||||
|
(and (<= (js/Math.abs (- x cx)) h) (<= (js/Math.abs (- y cy)) h)))
|
||||||
|
false))
|
||||||
|
|
||||||
|
(defn hit
|
||||||
|
"The row path of the topmost op in `ops`, in draw order, at stage point `[x y]`,
|
||||||
|
or nil."
|
||||||
|
[ops [x y]]
|
||||||
|
(some #(when (on? % x y) (path-of %)) (rseq (vec ops))))
|
||||||
|
|
||||||
|
(defn- prefix? [a b]
|
||||||
|
(and (<= (count a) (count b)) (= a (subvec b 0 (count a)))))
|
||||||
|
|
||||||
|
(defn choose
|
||||||
|
"The row path a click on `hit` selects, with `selected` the one selected now."
|
||||||
|
[selected hit deep?]
|
||||||
|
(cond
|
||||||
|
(nil? hit) nil
|
||||||
|
deep? hit
|
||||||
|
(and selected (prefix? selected hit)) selected
|
||||||
|
(and selected (prefix? (pop selected) hit)) (subvec hit 0 (count selected))
|
||||||
|
:else [(first hit)]))
|
||||||
|
|
||||||
|
(defn deeper
|
||||||
|
"One level into `selected` towards `hit`, for a double-click."
|
||||||
|
[selected hit]
|
||||||
|
(if (and selected hit (prefix? selected hit) (< (count selected) (count hit)))
|
||||||
|
(subvec hit 0 (inc (count selected)))
|
||||||
|
selected))
|
||||||
|
|
||||||
|
(defn local-bounds
|
||||||
|
"`[x0 y0 x1 y1]` around what node `n` draws on its own frame `f`, in its own
|
||||||
|
coordinates, or nil when it draws nothing there. Inside an instance is its
|
||||||
|
symbol, resolved at that frame."
|
||||||
|
[document store n f]
|
||||||
|
(let [grow (fn [[x0 y0 x1 y1 :as b] x y]
|
||||||
|
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
|
||||||
|
at #(ch/value-at (get (node/channels n) %) f store)]
|
||||||
|
(case (:kind n)
|
||||||
|
:instance
|
||||||
|
(let [sid (:of n)
|
||||||
|
frames (clip/frames document sid)
|
||||||
|
f (if (get-in n [:time :loop?]) (mod f frames) f)]
|
||||||
|
(when (< -1 f frames)
|
||||||
|
(reduce (fn [b {:keys [kind pts n cx cy r size]}]
|
||||||
|
(case kind
|
||||||
|
:poly (reduce #(grow %1 (aget pts (* 2 %2)) (aget pts (inc (* 2 %2))))
|
||||||
|
b (range n))
|
||||||
|
:disc (-> b (grow (- cx r) (- cy r)) (grow (+ cx r) (+ cy r)))
|
||||||
|
:rect (let [h (/ size 2)]
|
||||||
|
(-> b (grow (- cx h) (- cy h)) (grow (+ cx h) (+ cy h))))
|
||||||
|
b))
|
||||||
|
nil
|
||||||
|
((clip/resolver document store pal/index-of sid) f))))
|
||||||
|
:poly (let [pts (at [:geom :pts])]
|
||||||
|
(when-not (ch/nothing? pts)
|
||||||
|
(reduce (fn [b i] (grow b (ch/component pts (* 2 i)) (ch/component pts (inc (* 2 i)))))
|
||||||
|
nil (range (quot (if (vector? pts) (count pts) (.-length pts)) 2)))))
|
||||||
|
:disc (let [r (at [:geom :radius])] (when-not (ch/nothing? r) [(- r) (- r) r r]))
|
||||||
|
:rect (let [s (at [:geom :size])]
|
||||||
|
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h])))
|
||||||
|
nil)))
|
||||||
|
|
@ -54,6 +54,7 @@
|
||||||
(:require [arthur.domain.channel :as ch]
|
(:require [arthur.domain.channel :as ch]
|
||||||
[arthur.domain.node :as node]
|
[arthur.domain.node :as node]
|
||||||
[arthur.domain.pose :as pose]
|
[arthur.domain.pose :as pose]
|
||||||
|
[arthur.domain.trace :as trace]
|
||||||
[arthur.domain.palette :as pal]))
|
[arthur.domain.palette :as pal]))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
@ -301,7 +302,6 @@
|
||||||
(case (:kind n)
|
(case (:kind n)
|
||||||
:group nil
|
:group nil
|
||||||
:instance nil
|
:instance nil
|
||||||
:audio nil
|
|
||||||
|
|
||||||
:poly
|
:poly
|
||||||
(let [pts (rd [:geom :pts])]
|
(let [pts (rd [:geom :pts])]
|
||||||
|
|
@ -341,21 +341,25 @@
|
||||||
not an error, it is `(:nodes clip)` being nil and a frame resolving to no ops at
|
not an error, it is `(:nodes clip)` being nil and a frame resolving to no ops at
|
||||||
all. That reads as a black stage, or, in a benchmark, as \"0 nodes\" and a
|
all. That reads as a black stage, or, in a benchmark, as \"0 nodes\" and a
|
||||||
flattering number. It happened once while the split was being made, which is why
|
flattering number. It happened once while the split was being made, which is why
|
||||||
this is a guard and not a comment."
|
this is a guard and not a comment.
|
||||||
|
|
||||||
|
Sounds are left out: they are heard, not drawn, and have no transform to
|
||||||
|
evaluate. `audio/mix` is what plays them."
|
||||||
[sym]
|
[sym]
|
||||||
(let [nodes (:nodes sym)]
|
(let [nodes (:nodes sym)]
|
||||||
(when-not (map? nodes)
|
(when-not (map? nodes)
|
||||||
(throw (ex-info (str "not a symbol: :nodes is " (pr-str nodes)
|
(throw (ex-info (str "not a symbol: :nodes is " (pr-str nodes)
|
||||||
" — a clip is not a symbol, its `:symbols` hold them")
|
" — a clip is not a symbol, its `:symbols` hold them")
|
||||||
{:keys (vec (sort-by str (keys sym)))})))
|
{:keys (vec (sort-by str (keys sym)))})))
|
||||||
nodes))
|
(into {} (remove #(= :audio (:kind (val %)))) nodes)))
|
||||||
|
|
||||||
(defn- channel-frame
|
(defn- channel-frame
|
||||||
"Anchors select measured frames; marked channels read instance pose choices."
|
"A trace selects the measured frames its node reads; marked channels read
|
||||||
[choices anchors nodes source-fps picture-fps id c lf]
|
instance pose choices."
|
||||||
|
[choices traces nodes source-fps picture-fps id c lf]
|
||||||
(cond
|
(cond
|
||||||
(contains? anchors id)
|
(contains? traces id)
|
||||||
(pose/held-frame (get anchors id) lf lf)
|
(trace/held-frame (get traces id) lf)
|
||||||
|
|
||||||
(:pose-sampled? c)
|
(:pose-sampled? c)
|
||||||
(pose/source-frame choices
|
(pose/source-frame choices
|
||||||
|
|
@ -367,10 +371,12 @@
|
||||||
|
|
||||||
:else lf))
|
:else lf))
|
||||||
|
|
||||||
(defn- prepared-anchors [nodes]
|
(defn- prepared-traces [nodes]
|
||||||
(into {}
|
(into {}
|
||||||
(for [[id n] nodes :when (seq (:anchors n))]
|
(for [[id n] nodes
|
||||||
[id (vec (sort-by first (:anchors n)))])))
|
:let [p (trace/prepare (:trace n))]
|
||||||
|
:when p]
|
||||||
|
[id p])))
|
||||||
|
|
||||||
(defn- eval-into
|
(defn- eval-into
|
||||||
"One frame, as a fold over the nodes in topological order.
|
"One frame, as a fold over the nodes in topological order.
|
||||||
|
|
@ -422,11 +428,11 @@
|
||||||
([sym f store palette pose-tracks opts]
|
([sym f store palette pose-tracks opts]
|
||||||
(let [nodes (nodes-of sym)
|
(let [nodes (nodes-of sym)
|
||||||
choices (pose/prepare pose-tracks)
|
choices (pose/prepare pose-tracks)
|
||||||
anchors (prepared-anchors nodes)
|
traces (prepared-traces nodes)
|
||||||
{:keys [source-fps picture-fps]} opts
|
{:keys [source-fps picture-fps]} opts
|
||||||
ord (order nodes)]
|
ord (order nodes)]
|
||||||
(eval-into {:read (fn [id path c lf]
|
(eval-into {:read (fn [id path c lf]
|
||||||
(ch/value-at c (channel-frame choices anchors nodes
|
(ch/value-at c (channel-frame choices traces nodes
|
||||||
source-fps picture-fps id c lf)
|
source-fps picture-fps id c lf)
|
||||||
store))
|
store))
|
||||||
:palette palette
|
:palette palette
|
||||||
|
|
@ -486,7 +492,7 @@
|
||||||
([sym store palette pose-tracks {:keys [source-fps picture-fps]}]
|
([sym store palette pose-tracks {:keys [source-fps picture-fps]}]
|
||||||
(let [nodes (nodes-of sym)
|
(let [nodes (nodes-of sym)
|
||||||
choices (pose/prepare pose-tracks)
|
choices (pose/prepare pose-tracks)
|
||||||
anchors (prepared-anchors nodes)
|
traces (prepared-traces nodes)
|
||||||
ord (order nodes)
|
ord (order nodes)
|
||||||
rank (draw-rank nodes ord)
|
rank (draw-rank nodes ord)
|
||||||
cursors (into {}
|
cursors (into {}
|
||||||
|
|
@ -510,7 +516,7 @@
|
||||||
placed (volatile! {})
|
placed (volatile! {})
|
||||||
ctx {:read (fn [id path c lf]
|
ctx {:read (fn [id path c lf]
|
||||||
(ch/sample! (get-in cursors [id path])
|
(ch/sample! (get-in cursors [id path])
|
||||||
(channel-frame choices anchors nodes
|
(channel-frame choices traces nodes
|
||||||
source-fps picture-fps id c lf)))
|
source-fps picture-fps id c lf)))
|
||||||
:palette palette
|
:palette palette
|
||||||
:mat-for (fn [id] (get mats id))
|
:mat-for (fn [id] (get mats id))
|
||||||
|
|
@ -578,19 +584,14 @@
|
||||||
(into (for [[id n] nodes
|
(into (for [[id n] nodes
|
||||||
p (node/problems n)]
|
p (node/problems n)]
|
||||||
(str "node " (pr-str id) ": " p)))
|
(str "node " (pr-str id) ": " p)))
|
||||||
;; Anchors re-address the node's measurement, regardless of its name.
|
;; A trace re-addresses the node's measurement, regardless of its name.
|
||||||
(into (for [[id n] nodes
|
(into (for [[id n] nodes
|
||||||
:let [anchors (:anchors n)]
|
:when (some? (:trace n))
|
||||||
:when (some? anchors)
|
p (if (and (integer? (:frames sym)) (seq (:measured n))
|
||||||
:when (not (and (map? anchors) (contains? anchors 0)
|
(= (:channels n) (:measured n)))
|
||||||
(integer? (:frames sym))
|
(trace/problems (:trace n) (:frames sym))
|
||||||
(every? #(and (integer? %) (<= 0 %)
|
["a trace reads the node's own measured channels"])]
|
||||||
(< % (:frames sym)))
|
(str "node " (pr-str id) ": " p)))
|
||||||
(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 symbol-keys (keys sym))]
|
(into (for [k (remove symbol-keys (keys sym))]
|
||||||
(str "symbol has a field with no leaf to save it in: " (pr-str k))))
|
(str "symbol has a field with no leaf to save it in: " (pr-str k))))
|
||||||
(into (when-not (or (nil? (:frames sym)) (and (integer? (:frames sym)) (pos? (:frames sym))))
|
(into (when-not (or (nil? (:frames sym)) (and (integer? (:frames sym)) (pos? (:frames sym))))
|
||||||
|
|
|
||||||
147
frontend/src/arthur/domain/trace.cljs
Normal file
147
frontend/src/arthur/domain/trace.cljs
Normal file
|
|
@ -0,0 +1,147 @@
|
||||||
|
(ns arthur.domain.trace
|
||||||
|
"Tracing a face over its footage: which source frame the photo shows, where the
|
||||||
|
face's origin goes between those frames, and where the photo sits on stage.
|
||||||
|
|
||||||
|
TWO OWNERS, because they are two different kinds of decision. The trace frames
|
||||||
|
and the origin are the face's — they say how its drawings were made and how it
|
||||||
|
moves, so they live on its symbol's `:head`, and every instance of that face
|
||||||
|
shares them:
|
||||||
|
|
||||||
|
:trace {:frames [0 12 30] :origin :keys}
|
||||||
|
|
||||||
|
Whether the photo is showing, and how strongly, is a viewing aid for one
|
||||||
|
placement. It is on an INSTANCE, not keyed, and draws nothing into the picture.
|
||||||
|
It covers every face at or below that instance, and the nearest instance that
|
||||||
|
says anything decides, so a take shows its faces' footage and one face inside
|
||||||
|
it can still be switched off:
|
||||||
|
|
||||||
|
:underlay {:on? true :opacity 0.5}
|
||||||
|
|
||||||
|
THE TRACE IS THE ONE FACT about which measured frame a head reads. `:continuous`
|
||||||
|
reads the frame it is on, `:keys` jumps to each trace frame's measured head and
|
||||||
|
holds it — a hold, not a tween — and `:start` holds frame 0's forever. Before
|
||||||
|
the first trace frame, the first holds. `domain/symbol` reads the head through
|
||||||
|
`held-frame`, so nothing is derived from the trace and stored beside it.
|
||||||
|
Normalisation is per face because each face symbol has its own head."
|
||||||
|
(:require [arthur.domain.channel :as ch]
|
||||||
|
[arthur.domain.node :as node]
|
||||||
|
[arthur.domain.pose :as pose]))
|
||||||
|
|
||||||
|
(def origins [:continuous :keys :start])
|
||||||
|
|
||||||
|
(defn of
|
||||||
|
"The head's trace, a head that has none being one that moves freely."
|
||||||
|
[head]
|
||||||
|
(merge {:frames [] :origin :continuous} (:trace head)))
|
||||||
|
|
||||||
|
(defn prepare
|
||||||
|
"Trace `t` ready to be read every frame without allocating, or nil for a head
|
||||||
|
that reads the frame it is on."
|
||||||
|
[t]
|
||||||
|
(let [{:keys [frames origin]} (merge {:frames []} t)]
|
||||||
|
(case origin
|
||||||
|
:start {:entries [] :before 0}
|
||||||
|
:keys {:entries (mapv #(vector % %) frames) :before (or (first frames) 0)}
|
||||||
|
nil)))
|
||||||
|
|
||||||
|
(defn held-frame
|
||||||
|
"The measured frame a head with prepared trace `p` reads at its frame `f`."
|
||||||
|
[p f]
|
||||||
|
(pose/held-frame (:entries p) f (:before p)))
|
||||||
|
|
||||||
|
(defn problems
|
||||||
|
"Why `t` is not a trace for a symbol `frames` long. Empty when it is one."
|
||||||
|
[t frames]
|
||||||
|
(let [fs (:frames t)]
|
||||||
|
(cond-> []
|
||||||
|
(not (some #{(:origin t)} origins))
|
||||||
|
(conj (str ":origin is " (pr-str (:origin t)) ", not one of " (pr-str origins)))
|
||||||
|
(not (and (vector? fs) (= fs (vec (sort (distinct fs))))
|
||||||
|
(every? #(and (integer? %) (<= 0 %) (< % frames)) fs)))
|
||||||
|
(conj (str ":frames must be distinct frames of the symbol, in order: " (pr-str fs))))))
|
||||||
|
|
||||||
|
(defn toggle-frame
|
||||||
|
"A trace frame at `f`, or none there if there was one."
|
||||||
|
[t f]
|
||||||
|
(update t :frames
|
||||||
|
#(vec (sort (if (some #{f} %) (remove #{f} %) (conj % f))))))
|
||||||
|
|
||||||
|
(defn photo-frame
|
||||||
|
"Which of the face's own frames the photo shows at frame `f`: the last trace
|
||||||
|
frame at or before it, held, and before the first the first. With none, every
|
||||||
|
frame is its own."
|
||||||
|
[{:keys [frames]} f]
|
||||||
|
(if (seq frames)
|
||||||
|
(or (last (take-while #(<= % f) frames)) (first frames))
|
||||||
|
f))
|
||||||
|
|
||||||
|
(defn- measured-local
|
||||||
|
"The head's own measured transform at frame `p`, or nil where the face was not
|
||||||
|
found and there is none."
|
||||||
|
[head store p]
|
||||||
|
(let [[pos rot scale] (map #(ch/value-at (get (:measured head) %) p store)
|
||||||
|
[[:xform :pos] [:xform :rot] [:xform :scale]])]
|
||||||
|
(when-not (some ch/nothing? [pos rot scale])
|
||||||
|
(node/local! (node/mat) pos rot scale [0 0] [0 0]))))
|
||||||
|
|
||||||
|
(defn photo-matrix
|
||||||
|
"From the pixels of source frame `p`'s still, `image-h` pixels tall, to where
|
||||||
|
the head at world `world` puts them.
|
||||||
|
|
||||||
|
The landmarks were measured in image heights, so a pixel is 1/image-h of one;
|
||||||
|
the head's measured transform at `p` takes that frame's image space into the
|
||||||
|
head's; `world` takes the head's to the stage. When the head is showing frame
|
||||||
|
`p` itself the middle two cancel, and the photo sits exactly where the face
|
||||||
|
was filmed."
|
||||||
|
[world head store p image-h]
|
||||||
|
(when-let [inv (some-> (measured-local head store p) node/invert)]
|
||||||
|
(let [px (js/Float64Array. #js [(/ 1 image-h) 0 0 (/ 1 image-h) 0 0])]
|
||||||
|
(node/mul! (node/mat) (node/mul! (node/mat) world inv) px))))
|
||||||
|
|
||||||
|
(defn traceable?
|
||||||
|
"Does symbol `sid` have a measured head to trace over?"
|
||||||
|
[clip sid]
|
||||||
|
(seq (get-in clip [:symbols sid :nodes :head :measured])))
|
||||||
|
|
||||||
|
(defn faces
|
||||||
|
"The instances of faces inside symbol `sid`, at any depth, as `{:path :in
|
||||||
|
:face}`: the row path from `sid`, the symbol the instance is in, and the face
|
||||||
|
symbol it places."
|
||||||
|
[clip sid]
|
||||||
|
(letfn [(walk [sid path]
|
||||||
|
(mapcat (fn [[id n]]
|
||||||
|
(when (= :instance (:kind n))
|
||||||
|
(let [p (conj path id)]
|
||||||
|
(cond->> (walk (:of n) p)
|
||||||
|
(traceable? clip (:of n)) (cons {:path p :in sid :face (:of n)})))))
|
||||||
|
(sort-by (comp str key) (get-in clip [:symbols sid :nodes]))))]
|
||||||
|
(vec (walk sid []))))
|
||||||
|
|
||||||
|
(defn underlay-at
|
||||||
|
"The underlay in force at the instance at row path `path` from symbol `sid`:
|
||||||
|
the nearest one set on it or above it, `:own?` saying which. Nil when none is."
|
||||||
|
[clip sid path]
|
||||||
|
(:u (reduce (fn [{:keys [sid u]} id]
|
||||||
|
(let [n (get-in clip [:symbols sid :nodes id])]
|
||||||
|
{:sid (:of n)
|
||||||
|
:u (if-let [own (:underlay n)]
|
||||||
|
(assoc own :own? true)
|
||||||
|
(some-> u (assoc :own? false)))}))
|
||||||
|
{:sid sid} path)))
|
||||||
|
|
||||||
|
(defn shown
|
||||||
|
"Every face whose footage shows from symbol `sid` down, as `{:path :face
|
||||||
|
:opacity}`: the row path of the face's instance, the face's symbol, and how
|
||||||
|
strongly to draw it."
|
||||||
|
[clip sid]
|
||||||
|
(letfn [(walk [sid path opacity]
|
||||||
|
(mapcat (fn [[id n]]
|
||||||
|
(when (= :instance (:kind n))
|
||||||
|
(let [path (conj path id)
|
||||||
|
u (:underlay n)
|
||||||
|
opacity (if u (when (:on? u) (:opacity u 0.5)) opacity)]
|
||||||
|
(cond->> (walk (:of n) path opacity)
|
||||||
|
(and opacity (traceable? clip (:of n)))
|
||||||
|
(cons {:path path :face (:of n) :opacity opacity})))))
|
||||||
|
(get-in clip [:symbols sid :nodes])))]
|
||||||
|
(vec (walk sid [] nil))))
|
||||||
|
|
@ -310,8 +310,10 @@
|
||||||
(rf/reg-fx
|
(rf/reg-fx
|
||||||
::list!
|
::list!
|
||||||
(fn [_]
|
(fn [_]
|
||||||
(-> (ingest/available!)
|
(-> (js/Promise.all #js [(ingest/available!)
|
||||||
(.then (fn [footage] (rf/dispatch [::listed footage])))
|
(.then (http/GET "/api/sounds")
|
||||||
|
#(:sounds (js->clj % :keywordize-keys true)))])
|
||||||
|
(.then (fn [[footage sounds]] (rf/dispatch [::listed footage sounds])))
|
||||||
(.catch (fn [error]
|
(.catch (fn [error]
|
||||||
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
|
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
|
||||||
|
|
||||||
|
|
@ -341,24 +343,38 @@
|
||||||
(.catch (fn [error]
|
(.catch (fn [error]
|
||||||
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
|
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
|
||||||
|
|
||||||
|
(rf/reg-fx
|
||||||
|
::upload-sound!
|
||||||
|
(fn [file]
|
||||||
|
(let [form (js/FormData.)]
|
||||||
|
(.append form "file" file)
|
||||||
|
(-> (http/POST-form "/api/sounds" form)
|
||||||
|
(.then (fn [^js sound] (rf/dispatch [::uploaded (.-id sound) "sound imported"])))
|
||||||
|
(.catch (fn [error]
|
||||||
|
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
|
||||||
|
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
::upload
|
::upload
|
||||||
(fn [{:keys [db]} [_ file]]
|
(fn [{:keys [db]} [_ ^js file]]
|
||||||
(if (or (nil? file) (get-in db [:footage :loading?]))
|
;; By type, and by name for a browser that leaves the type empty.
|
||||||
{}
|
(let [sound? (and file (or (string/starts-with? (.-type file) "audio/")
|
||||||
{:db (update db :footage merge {:loading? true :status "uploading video…"})
|
(re-find #"(?i)\.(mp3|wav|aiff?|flac|ogg|m4a|aac)$" (.-name file))))]
|
||||||
::upload! file})))
|
(if (or (nil? file) (get-in db [:footage :loading?]))
|
||||||
|
{}
|
||||||
|
{:db (update db :footage merge {:loading? true
|
||||||
|
:status (if sound? "uploading sound…" "uploading video…")})
|
||||||
|
(if sound? ::upload-sound! ::upload!) file}))))
|
||||||
|
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
::uploaded
|
::uploaded
|
||||||
(fn [{:keys [db]} [_ footage-id]]
|
(fn [{:keys [db]} [_ id status]]
|
||||||
;; Into the pool, and no further. An upload is media for this project; turning
|
;; Into the pool, and no further. An upload is media for this project; turning
|
||||||
;; it into a symbol is a separate decision — which frames, what name — made by
|
;; it into a symbol or a sound is a separate decision — which frames, what
|
||||||
;; dropping it where it should go.
|
;; name, where — made by dropping it where it should go.
|
||||||
{:db (update db :footage #(-> %
|
{:db (update db :footage #(-> %
|
||||||
(merge {:loading? false :chosen footage-id
|
(merge {:loading? false :status (or status "video extracted")})
|
||||||
:status "video extracted"})
|
(cond-> (not status) (assoc :chosen id))
|
||||||
(update :uploaded (fnil conj #{}) footage-id)))
|
(update :uploaded (fnil conj #{}) id)))
|
||||||
:dispatch [::refresh]}))
|
:dispatch [::refresh]}))
|
||||||
|
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
|
|
@ -367,9 +383,10 @@
|
||||||
|
|
||||||
(rf/reg-event-db
|
(rf/reg-event-db
|
||||||
::listed
|
::listed
|
||||||
(fn [db [_ footage]]
|
(fn [db [_ footage sounds]]
|
||||||
(update db :footage merge
|
(update db :footage merge
|
||||||
(cond-> {:available (vec footage)
|
(cond-> {:available (vec footage)
|
||||||
|
:sounds (vec sounds)
|
||||||
:chosen (or (:chosen (:footage db)) (:id (first footage)))}
|
:chosen (or (:chosen (:footage db)) (:id (first footage)))}
|
||||||
(empty? footage) (assoc :status "upload a video to begin")))))
|
(empty? footage) (assoc :status "upload a video to begin")))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -23,8 +23,3 @@
|
||||||
::set-vertex
|
::set-vertex
|
||||||
(fn [db [_ sid id key-frame vertex point]]
|
(fn [db [_ sid id key-frame vertex point]]
|
||||||
(edit/edit db #(paint/set-vertex % sid id key-frame vertex point))))
|
(edit/edit db #(paint/set-vertex % sid id key-frame vertex point))))
|
||||||
|
|
||||||
(rf/reg-event-db
|
|
||||||
::set-segment-interp
|
|
||||||
(fn [db [_ sid id key-frame interp]]
|
|
||||||
(edit/edit db #(paint/set-segment-interp % sid id key-frame interp))))
|
|
||||||
|
|
|
||||||
|
|
@ -624,6 +624,24 @@
|
||||||
(fn [db [_ sid id path frame]]
|
(fn [db [_ sid id path frame]]
|
||||||
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame))))
|
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame))))
|
||||||
|
|
||||||
|
;; A face's trace frames and origin, on its symbol — see `domain/trace`.
|
||||||
|
(rf/reg-event-db
|
||||||
|
::set-trace
|
||||||
|
(fn [db [_ sid value]]
|
||||||
|
(edit/edit db #(assoc-in % [:symbols sid :nodes :head :trace] value))))
|
||||||
|
|
||||||
|
;; Whether one instance shows its face's footage under it. Not keyed: it is a
|
||||||
|
;; drawing aid, not part of the picture.
|
||||||
|
(rf/reg-event-db
|
||||||
|
::set-underlay
|
||||||
|
(fn [db [_ sid id underlay]]
|
||||||
|
(edit/edit db #(assoc-in % [:symbols sid :nodes id :underlay] underlay))))
|
||||||
|
|
||||||
|
(rf/reg-event-db
|
||||||
|
::set-segment-interp
|
||||||
|
(fn [db [_ sid id path left interp]]
|
||||||
|
(edit/edit db #(update-in % [:symbols sid :nodes id] node/set-segment-interp path left interp))))
|
||||||
|
|
||||||
(rf/reg-event-fx
|
(rf/reg-event-fx
|
||||||
::list
|
::list
|
||||||
(fn [{:keys [db]} _]
|
(fn [{:keys [db]} _]
|
||||||
|
|
|
||||||
|
|
@ -6,6 +6,7 @@
|
||||||
there should not be one: an editor's own state is the cheapest thing in the
|
there should not be one: an editor's own state is the cheapest thing in the
|
||||||
app to change and the most expensive to have two copies of."
|
app to change and the most expensive to have two copies of."
|
||||||
(:require [arthur.domain.clip :as clip]
|
(:require [arthur.domain.clip :as clip]
|
||||||
|
[arthur.domain.gesture :as gesture]
|
||||||
[arthur.domain.nest :as nest]
|
[arthur.domain.nest :as nest]
|
||||||
[arthur.events.edit :as edit]
|
[arthur.events.edit :as edit]
|
||||||
[arthur.events.paint :as paint]
|
[arthur.events.paint :as paint]
|
||||||
|
|
@ -14,7 +15,18 @@
|
||||||
|
|
||||||
(rf/reg-event-db
|
(rf/reg-event-db
|
||||||
::select
|
::select
|
||||||
(fn [db [_ selection]] (assoc-in db [:ui :selection] selection)))
|
;; The rows above a selection are opened, so one made deep on the stage is
|
||||||
|
;; seen in the timeline. Not a sound's: its row is always in the audio section,
|
||||||
|
;; and opening the placement it is heard through would bury it.
|
||||||
|
(fn [db [_ selection]]
|
||||||
|
(let [[kind sid id path] selection
|
||||||
|
sound? (= :audio (get-in (store/entry (:clip/current db))
|
||||||
|
[:clip :symbols sid :nodes id :kind]))]
|
||||||
|
(cond-> (-> db
|
||||||
|
(assoc-in [:ui :selection] selection)
|
||||||
|
(update :ui dissoc :points))
|
||||||
|
(and (= :node kind) path (not sound?))
|
||||||
|
(update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))))
|
||||||
|
|
||||||
(rf/reg-event-db
|
(rf/reg-event-db
|
||||||
::set-tone
|
::set-tone
|
||||||
|
|
@ -165,6 +177,16 @@
|
||||||
host sid frame uuid point))
|
host sid frame uuid point))
|
||||||
(assoc-in [:ui :selection] [:node host uuid [uuid]])))))
|
(assoc-in [:ui :selection] [:node host uuid [uuid]])))))
|
||||||
|
|
||||||
|
(rf/reg-event-db
|
||||||
|
::drop-sound
|
||||||
|
(fn [db [_ {:keys [source label length rate]} frame]]
|
||||||
|
(let [uuid (random-uuid)
|
||||||
|
host (get-in db [:ui :open])]
|
||||||
|
(-> db
|
||||||
|
(update :ui dissoc :drop)
|
||||||
|
(edit/edit #(clip/place-sound % host source label length rate frame uuid))
|
||||||
|
(assoc-in [:ui :selection] [:node host uuid [uuid]])))))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; moving rows between symbols
|
;; moving rows between symbols
|
||||||
;;
|
;;
|
||||||
|
|
@ -186,7 +208,8 @@
|
||||||
(-> db
|
(-> db
|
||||||
(edit/edit (constantly (:clip r)))
|
(edit/edit (constantly (:clip r)))
|
||||||
(assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj to (:id r))])
|
(assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj to (:id r))])
|
||||||
(update-in [:ui :expanded] into (rest (reductions conj [] to))))))))
|
(cond-> (not= :audio (get-in r [:clip :symbols (:sid r) :nodes (:id r) :kind]))
|
||||||
|
(update-in [:ui :expanded] into (rest (reductions conj [] to)))))))))
|
||||||
|
|
||||||
(rf/reg-event-db
|
(rf/reg-event-db
|
||||||
::sliding
|
::sliding
|
||||||
|
|
@ -207,6 +230,32 @@
|
||||||
(:refused r) (refused db (:refused r))
|
(:refused r) (refused db (:refused r))
|
||||||
:else (edit/edit db (constantly (:clip r)))))))
|
:else (edit/edit db (constantly (:clip r)))))))
|
||||||
|
|
||||||
|
(rf/reg-event-db
|
||||||
|
::points
|
||||||
|
;; Editing the selected shape's points rather than transforming it — a
|
||||||
|
;; double-click on the shape, as Figma's, which is one level further in. Any
|
||||||
|
;; new selection leaves it.
|
||||||
|
(fn [db [_ on?]]
|
||||||
|
(if on? (assoc-in db [:ui :points] true) (update db :ui dissoc :points))))
|
||||||
|
|
||||||
|
(rf/reg-event-db
|
||||||
|
::refuse
|
||||||
|
(fn [db [_ why]] (refused db why)))
|
||||||
|
|
||||||
|
(rf/reg-event-db
|
||||||
|
::gesture
|
||||||
|
;; A transform in the middle of a drag on the stage, `{:sid :id :frame
|
||||||
|
;; :values}`, drawn by `::render/clip` as `::sliding` is; nil when abandoned.
|
||||||
|
(fn [db [_ g]]
|
||||||
|
(if g (assoc-in db [:ui :gesture] g) (update db :ui dissoc :gesture))))
|
||||||
|
|
||||||
|
(rf/reg-event-db
|
||||||
|
::transform
|
||||||
|
;; The drag let go: one edit, so one undo step and one write to collaborators.
|
||||||
|
(fn [db [_ {:keys [sid id frame values]}]]
|
||||||
|
(cond-> (update db :ui dissoc :gesture)
|
||||||
|
(seq values) (edit/edit #(gesture/apply-values % sid id frame values)))))
|
||||||
|
|
||||||
(rf/reg-event-db
|
(rf/reg-event-db
|
||||||
::delete-selected
|
::delete-selected
|
||||||
(fn [db _]
|
(fn [db _]
|
||||||
|
|
|
||||||
|
|
@ -36,6 +36,7 @@
|
||||||
[arthur.domain.feature :as feature]
|
[arthur.domain.feature :as feature]
|
||||||
[arthur.domain.geom :as geom]
|
[arthur.domain.geom :as geom]
|
||||||
[arthur.domain.ring :as ring]
|
[arthur.domain.ring :as ring]
|
||||||
|
[arthur.domain.trace :as trace]
|
||||||
[arthur.flow.address :as address]))
|
[arthur.flow.address :as address]))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
|
|
@ -245,47 +246,38 @@
|
||||||
:tx (* (- s') (+ (* c tx) (* sn ty)))
|
:tx (* (- s') (+ (* c tx) (* sn ty)))
|
||||||
:ty (* (- s') (+ (* (- sn) tx) (* c ty)))}))
|
:ty (* (- s') (+ (* (- sn) tx) (* c ty)))}))
|
||||||
|
|
||||||
(def ^:private head-modes #{:free :anchored})
|
|
||||||
|
|
||||||
(defn head-mode
|
(defn head-mode
|
||||||
"Keep a subject's measured transform dense; optionally hold chosen source
|
"Keep a subject's measured transform dense; optionally trace it.
|
||||||
frames.
|
|
||||||
|
|
||||||
A nil anchor map reads measured frame f at frame f (free movement).
|
With no trace the head reads measured frame f at frame f (free movement).
|
||||||
`{0 12}` locks to the measured transform of source frame 12. `{0 12, 40 42}`
|
`{:frames [12] :origin :keys}` holds the measured transform of source frame
|
||||||
cuts to source frame 42 at local frame 40. The same map selects position,
|
12, `{:frames [12 42] :origin :keys}` jumps to 42's at 42, and `{:origin
|
||||||
rotation and scale, so the head and registered photo cannot drift apart.
|
:start}` holds frame 0's. See `domain/trace`. The trace selects position,
|
||||||
No analysis block or authored face placement changes.
|
rotation and scale together, so the head and registered photo cannot drift
|
||||||
|
apart. No analysis block or authored face placement changes.
|
||||||
|
|
||||||
ONE SUBJECT AT A TIME when `:subject` is given, and EVERY subject when it is
|
ONE SUBJECT AT A TIME when `:subject` is given, and EVERY subject when it is
|
||||||
not. Two faces in one shot were filmed together and are posed apart: choosing
|
not. Two faces in one shot were filmed together and are posed apart: choosing
|
||||||
frame 12 for the second face must leave the first one running, and it does,
|
frame 12 for the second face must leave the first one running, and it does,
|
||||||
because an anchor map lives on that subject's own head node and
|
because a trace lives on that subject's own head node and `domain/symbol`
|
||||||
`domain/symbol` reads anchors off whatever node carries them."
|
reads it off whatever node carries it."
|
||||||
[{:keys [subject mode anchors]} {:keys [clip]}]
|
[{:keys [subject] t :trace} {:keys [clip]}]
|
||||||
(when-not (contains? head-modes mode)
|
|
||||||
(throw (ex-info "head mode must be free or anchored"
|
|
||||||
{: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)))
|
(when (and subject (not (contains? (:subjects clip) subject)))
|
||||||
(throw (ex-info "head mode names a subject this clip did not track"
|
(throw (ex-info "head mode names a subject this clip did not track"
|
||||||
{:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))})))
|
{:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))})))
|
||||||
(reduce
|
(let [t (some->> t (merge {:frames []}))]
|
||||||
(fn [c sid]
|
(reduce
|
||||||
(let [frames (get-in c [:symbols sid :frames])]
|
(fn [c sid]
|
||||||
(when (and (= mode :anchored)
|
(let [frames (get-in c [:symbols sid :frames])]
|
||||||
(not (and (map? anchors) (contains? anchors 0)
|
(when-let [why (some-> t (trace/problems frames) first)]
|
||||||
(every? #(and (integer? %) (<= 0 %) (< % frames))
|
(throw (ex-info (str "a head's trace is not one this take can hold: " why)
|
||||||
(concat (keys anchors) (vals anchors))))))
|
{:subject sid :trace t :frames frames})))
|
||||||
(throw (ex-info "anchored head needs a frame-zero key and valid source frames"
|
(update-in c [:symbols sid :nodes :head]
|
||||||
{:subject sid :anchors anchors :frames frames})))
|
(fn [n]
|
||||||
(update-in c [:symbols sid :nodes :head]
|
(cond-> (assoc n :channels (:measured n))
|
||||||
(fn [n]
|
t (assoc :trace t)
|
||||||
(cond-> (assoc n :channels (:measured n))
|
(nil? t) (dissoc :trace))))))
|
||||||
(= mode :anchored) (assoc :anchors anchors)
|
clip (if subject [subject] (sort-by str (keys (:subjects clip)))))))
|
||||||
(= mode :free) (dissoc :anchors))))))
|
|
||||||
clip (if subject [subject] (sort-by str (keys (:subjects clip))))))
|
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; the aperture, onto [:vis] of :mouth-in
|
;; the aperture, onto [:vis] of :mouth-in
|
||||||
|
|
@ -688,9 +680,9 @@
|
||||||
existing instance scope. Features name local nodes in that subject's symbol;
|
existing instance scope. Features name local nodes in that subject's symbol;
|
||||||
block descriptors still name globally distinct features.
|
block descriptors still name globally distinct features.
|
||||||
|
|
||||||
Subjects share a source frame space. :head and :anchors may be overridden
|
Subjects share a source frame space. :trace may be overridden per subject;
|
||||||
per subject; all other freeze settings come from params."
|
all other freeze settings come from params."
|
||||||
[{:keys [name fps stage expose head anchors] :as params} subjects]
|
[{:keys [name fps stage expose] :as params} subjects]
|
||||||
(when-not (and (map? subjects) (seq subjects)
|
(when-not (and (map? subjects) (seq subjects)
|
||||||
(every? keyword? (keys subjects))
|
(every? keyword? (keys subjects))
|
||||||
(not-any? #{:main :root :face} (keys subjects)))
|
(not-any? #{:main :root :face} (keys subjects)))
|
||||||
|
|
@ -729,7 +721,6 @@
|
||||||
{:subject subject :feature id :frames nf :actual (count track)}))))
|
{:subject subject :feature id :frames nf :actual (count track)}))))
|
||||||
{:store (merged :store)
|
{:store (merged :store)
|
||||||
:clip (reduce (fn [c [subject inputs]]
|
:clip (reduce (fn [c [subject inputs]]
|
||||||
(head-mode {:subject subject :mode (or (:head inputs) head)
|
(head-mode {:subject subject :trace (get inputs :trace (:trace params))}
|
||||||
:anchors (get inputs :anchors anchors)}
|
|
||||||
{:clip c}))
|
{:clip c}))
|
||||||
built ordered)}))
|
built ordered)}))
|
||||||
|
|
|
||||||
|
|
@ -127,7 +127,7 @@
|
||||||
{:name (or (:source manifest) "footage")
|
{:name (or (:source manifest) "footage")
|
||||||
:fps (:fps manifest) :aspect (/ w h)
|
:fps (:fps manifest) :aspect (/ w h)
|
||||||
:stage [320 200] :fit-motion? true
|
:stage [320 200] :fit-motion? true
|
||||||
:expose 1 :head :free
|
:expose 1
|
||||||
;; The detector's identity comes from the server, which
|
;; The detector's identity comes from the server, which
|
||||||
;; hashes the model asset it serves rather than trusting a
|
;; hashes the model asset it serves rather than trusting a
|
||||||
;; version string somebody has to remember to bump. See
|
;; version string somebody has to remember to bump. See
|
||||||
|
|
|
||||||
|
|
@ -8,8 +8,11 @@
|
||||||
recomputation here and a frame costs a lookup and a blit — and, crucially, the
|
recomputation here and a frame costs a lookup and a blit — and, crucially, the
|
||||||
playhead is not an input, so moving it cannot invalidate this."
|
playhead is not an input, so moving it cannot invalidate this."
|
||||||
(:require [arthur.domain.clip :as clip]
|
(:require [arthur.domain.clip :as clip]
|
||||||
|
[arthur.domain.gesture :as gesture]
|
||||||
[arthur.domain.nest :as nest]
|
[arthur.domain.nest :as nest]
|
||||||
[arthur.domain.palette :as pal]
|
[arthur.domain.palette :as pal]
|
||||||
|
[arthur.domain.symbol :as symbol]
|
||||||
|
[arthur.domain.trace :as trace]
|
||||||
[arthur.footage.store :as footage]
|
[arthur.footage.store :as footage]
|
||||||
[arthur.subs.playback :as playback]
|
[arthur.subs.playback :as playback]
|
||||||
[re-frame.core :as rf]))
|
[re-frame.core :as rf]))
|
||||||
|
|
@ -19,6 +22,7 @@
|
||||||
|
|
||||||
(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open])))
|
(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open])))
|
||||||
(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
|
(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
|
||||||
|
(rf/reg-sub ::gesture (fn [db _] (get-in db [:ui :gesture])))
|
||||||
(rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])])))
|
(rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])])))
|
||||||
|
|
||||||
(rf/reg-sub
|
(rf/reg-sub
|
||||||
|
|
@ -26,16 +30,30 @@
|
||||||
:<- [::clip-id]
|
:<- [::clip-id]
|
||||||
:<- [::paint-revision]
|
:<- [::paint-revision]
|
||||||
:<- [::sliding]
|
:<- [::sliding]
|
||||||
|
:<- [::gesture]
|
||||||
:<- [::open]
|
:<- [::open]
|
||||||
(fn [[id _ sliding open] _]
|
(fn [[id _ sliding gesture open] _]
|
||||||
;; With a timeline bar being slid, the document as it will be when the drag
|
;; With a timeline bar being slid, the document as it will be when the drag
|
||||||
;; lets go, so the stage and the rows follow the pointer. Nothing is written
|
;; lets go, so the stage and the rows follow the pointer. Nothing is written
|
||||||
;; until then: one drag is one undo step and one write to collaborators.
|
;; until then: one drag is one undo step and one write to collaborators.
|
||||||
(let [c (:clip (footage/entry id))]
|
(let [c (:clip (footage/entry id))]
|
||||||
(or (when-let [{:keys [path df]} sliding]
|
(or (when-let [{:keys [path df]} sliding]
|
||||||
(:clip (nest/slide c open path df)))
|
(:clip (nest/slide c open path df)))
|
||||||
|
(when-let [{:keys [sid id frame values]} gesture]
|
||||||
|
(when c (gesture/apply-values c sid id frame values)))
|
||||||
c))))
|
c))))
|
||||||
|
|
||||||
|
(rf/reg-sub
|
||||||
|
::sounds
|
||||||
|
:<- [::clip-id]
|
||||||
|
:<- [::paint-revision]
|
||||||
|
:<- [::open]
|
||||||
|
(fn [[id _ sid] _]
|
||||||
|
;; What the open symbol plays, off the document as saved rather than `::clip`,
|
||||||
|
;; so a bar being slid does not re-mix on every frame of the drag.
|
||||||
|
(let [c (:clip (footage/entry id))]
|
||||||
|
[sid (when (clip/symbol c sid) (nest/audio-tracks c sid))])))
|
||||||
|
|
||||||
(rf/reg-sub
|
(rf/reg-sub
|
||||||
::symbol
|
::symbol
|
||||||
:<- [::clip]
|
:<- [::clip]
|
||||||
|
|
@ -125,9 +143,32 @@
|
||||||
(if (or (nil? resolve) (empty? solo))
|
(if (or (nil? resolve) (empty? solo))
|
||||||
resolve
|
resolve
|
||||||
;; An op inside an instance is named by the path its row has; one at the
|
;; An op inside an instance is named by the path its row has; one at the
|
||||||
;; top by its bare id.
|
;; top by its bare id. Still the resolver underneath, so where a node
|
||||||
(fn [f]
|
;; went on the frame is still asked of it.
|
||||||
(filterv (fn [{n :node}]
|
(reify
|
||||||
(let [p (if (vector? n) n [n])]
|
IFn
|
||||||
(some #(= % (take (count %) p)) solo)))
|
(-invoke [_ f]
|
||||||
(resolve f)))))))
|
(filterv (fn [{n :node}]
|
||||||
|
(let [p (if (vector? n) n [n])]
|
||||||
|
(some #(= % (take (count %) p)) solo)))
|
||||||
|
(resolve f)))
|
||||||
|
symbol/IResolver
|
||||||
|
(world-of [_ path] (symbol/world-of resolve path))
|
||||||
|
(frame-of [_ path] (symbol/frame-of resolve path)))))))
|
||||||
|
|
||||||
|
(rf/reg-sub
|
||||||
|
::underlay
|
||||||
|
:<- [::clip-id]
|
||||||
|
:<- [::clip]
|
||||||
|
:<- [::store]
|
||||||
|
:<- [::open]
|
||||||
|
:<- [::solo]
|
||||||
|
(fn [[id document store open solo] _]
|
||||||
|
;; What `ui/underlay` needs to paint the footage under the faces being
|
||||||
|
;; traced, besides the resolver that says where they went. A face outside
|
||||||
|
;; every soloed row is not on stage, so neither is its footage.
|
||||||
|
(let [solo (filter #(placed? document open %) solo)]
|
||||||
|
{:document document :store store
|
||||||
|
:footage-id (:footage-id (footage/entry id))
|
||||||
|
:traces (cond->> (when document (trace/shown document open))
|
||||||
|
(seq solo) (filterv (fn [{:keys [path]}] (some #(= % (take (count %) path)) solo))))})))
|
||||||
|
|
|
||||||
|
|
@ -5,6 +5,7 @@
|
||||||
Cheap by construction, like `subs/playback`: each reads a path and returns a
|
Cheap by construction, like `subs/playback`: each reads a path and returns a
|
||||||
value, so clicking a swatch notifies the swatches and nothing else."
|
value, so clicking a swatch notifies the swatches and nothing else."
|
||||||
(:require [arthur.domain.nest :as nest]
|
(:require [arthur.domain.nest :as nest]
|
||||||
|
[arthur.domain.pick :as pick]
|
||||||
[arthur.footage.store :as store]
|
[arthur.footage.store :as store]
|
||||||
[arthur.subs.playback :as playback]
|
[arthur.subs.playback :as playback]
|
||||||
[arthur.subs.render :as render]
|
[arthur.subs.render :as render]
|
||||||
|
|
@ -19,6 +20,7 @@
|
||||||
(rf/reg-sub ::tabs (fn [db _] (get-in db [:ui :tabs])))
|
(rf/reg-sub ::tabs (fn [db _] (get-in db [:ui :tabs])))
|
||||||
(rf/reg-sub ::expanded (fn [db _] (get-in db [:ui :expanded])))
|
(rf/reg-sub ::expanded (fn [db _] (get-in db [:ui :expanded])))
|
||||||
(rf/reg-sub ::knobs (fn [db _] (get-in db [:ui :knobs])))
|
(rf/reg-sub ::knobs (fn [db _] (get-in db [:ui :knobs])))
|
||||||
|
(rf/reg-sub ::points (fn [db _] (get-in db [:ui :points])))
|
||||||
|
|
||||||
(rf/reg-sub
|
(rf/reg-sub
|
||||||
::selected-node
|
::selected-node
|
||||||
|
|
@ -49,6 +51,23 @@
|
||||||
(let [{clip :clip st :store} (store/entry clip-id)]
|
(let [{clip :clip st :store} (store/entry clip-id)]
|
||||||
(nest/inside clip st open (or path [id]) f)))))
|
(nest/inside clip st open (or path [id]) f)))))
|
||||||
|
|
||||||
|
(rf/reg-sub
|
||||||
|
::selected-placement
|
||||||
|
:<- [::selected-node]
|
||||||
|
:<- [::selection]
|
||||||
|
:<- [::render/clip]
|
||||||
|
:<- [::render/clip-id]
|
||||||
|
:<- [::render/open]
|
||||||
|
:<- [::playback/frame]
|
||||||
|
(fn [[[_ id n] [_ _ _ path] clip clip-id open f] _]
|
||||||
|
;; `nest/placement` of the selected node, and `:bounds` around what it draws
|
||||||
|
;; in its own coordinates, for the stage's handles. From the clip as it is
|
||||||
|
;; mid-drag, so the handles go with what they move.
|
||||||
|
(when n
|
||||||
|
(let [st (:store (store/entry clip-id))]
|
||||||
|
(when-let [pl (nest/placement clip st open (or path [id]) f)]
|
||||||
|
(assoc pl :node n :bounds (pick/local-bounds clip st n (:frame pl))))))))
|
||||||
|
|
||||||
(rf/reg-sub
|
(rf/reg-sub
|
||||||
::project-footage
|
::project-footage
|
||||||
:<- [::render/clip-id]
|
:<- [::render/clip-id]
|
||||||
|
|
@ -67,3 +86,19 @@
|
||||||
:when f]
|
:when f]
|
||||||
f))]
|
f))]
|
||||||
(filterv #(contains? used (:id %)) available))))
|
(filterv #(contains? used (:id %)) available))))
|
||||||
|
|
||||||
|
(rf/reg-sub
|
||||||
|
::project-sounds
|
||||||
|
:<- [::render/clip-id]
|
||||||
|
:<- [::render/paint-revision]
|
||||||
|
:<- [::playback/footage]
|
||||||
|
(fn [[id _ {:keys [sounds uploaded]}] _]
|
||||||
|
;; As `::project-footage`: the sounds this document plays, and those uploaded
|
||||||
|
;; while it was open.
|
||||||
|
(let [used (into (set uploaded)
|
||||||
|
(for [[_ sym] (get-in (store/entry id) [:clip :symbols])
|
||||||
|
[_ n] (:nodes sym)
|
||||||
|
:let [s (get-in n [:source :sound])]
|
||||||
|
:when s]
|
||||||
|
s))]
|
||||||
|
(filterv #(contains? used (:id %)) sounds))))
|
||||||
|
|
|
||||||
|
|
@ -52,19 +52,24 @@
|
||||||
out of the pool, and not one that would make a cycle."
|
out of the pool, and not one that would make a cycle."
|
||||||
[]
|
[]
|
||||||
(let [c @carrying]
|
(let [c @carrying]
|
||||||
(and c (#{:symbol :footage :import} (:kind c)) (not (:refused? c)))))
|
(and c (#{:symbol :footage :import :sound} (:kind c)) (not (:refused? c)))))
|
||||||
|
|
||||||
(defn row!
|
(defn row!
|
||||||
"Start carrying the timeline row at `path` — a node, to be moved into another
|
"Start carrying the timeline row at `path` — a node of kind `node-kind`, to be
|
||||||
symbol or grouped with another node."
|
moved into another symbol or grouped with another node."
|
||||||
[path]
|
[path node-kind]
|
||||||
(reset! carrying {:kind :row :path path}))
|
(reset! carrying {:kind :row :path path :node-kind node-kind}))
|
||||||
|
|
||||||
(defn row
|
(defn row
|
||||||
"The path of the row being carried, or nil when it is not a row."
|
"The path of the row being carried, or nil when it is not a row."
|
||||||
[]
|
[]
|
||||||
(let [c @carrying] (when (= :row (:kind c)) (:path c))))
|
(let [c @carrying] (when (= :row (:kind c)) (:path c))))
|
||||||
|
|
||||||
|
(defn row-kind
|
||||||
|
"The node kind of the row being carried."
|
||||||
|
[]
|
||||||
|
(:node-kind @carrying))
|
||||||
|
|
||||||
(defn other!
|
(defn other!
|
||||||
"Start carrying something that is not yet in the document: `:kind` says what,
|
"Start carrying something that is not yet in the document: `:kind` says what,
|
||||||
and the rest is what a preview can show of it before it is fetched."
|
and the rest is what a preview can show of it before it is fetched."
|
||||||
|
|
@ -81,9 +86,10 @@
|
||||||
"Say where the drag would land, for the previews. `point` is nil over the
|
"Say where the drag would land, for the previews. `point` is nil over the
|
||||||
timeline."
|
timeline."
|
||||||
[where frame point]
|
[where frame point]
|
||||||
(when-let [{:keys [label frames]} @carrying]
|
(when-let [{:keys [kind label frames]} @carrying]
|
||||||
(rf/dispatch [::ui/drop-hover {:where where :frame frame :point point
|
(rf/dispatch [::ui/drop-hover {:where where :frame frame :point point
|
||||||
:label label :frames frames}])))
|
:label label :frames frames
|
||||||
|
:sound? (= :sound kind)}])))
|
||||||
|
|
||||||
(defn pos-for
|
(defn pos-for
|
||||||
"Where the preview goes so the symbol's middle is under `point` — what
|
"Where the preview goes so the symbol's middle is under `point` — what
|
||||||
|
|
@ -102,5 +108,7 @@
|
||||||
;; the symbol they become is called.
|
;; the symbol they become is called.
|
||||||
:footage (rf/dispatch [::footage/ask-convert c frame point])
|
:footage (rf/dispatch [::footage/ask-convert c frame point])
|
||||||
:import (rf/dispatch [::project/import c frame point])
|
:import (rf/dispatch [::project/import c frame point])
|
||||||
|
;; Where it is dropped in time; a sound has no place in space.
|
||||||
|
:sound (rf/dispatch [::ui/drop-sound c frame])
|
||||||
nil))
|
nil))
|
||||||
(done!))
|
(done!))
|
||||||
|
|
|
||||||
|
|
@ -13,6 +13,7 @@
|
||||||
[arthur.domain.node :as node]
|
[arthur.domain.node :as node]
|
||||||
[arthur.domain.paint :as paint]
|
[arthur.domain.paint :as paint]
|
||||||
[arthur.domain.params :as params]
|
[arthur.domain.params :as params]
|
||||||
|
[arthur.domain.trace :as trace]
|
||||||
[arthur.events.history :as history]
|
[arthur.events.history :as history]
|
||||||
[arthur.events.paint :as paint-events]
|
[arthur.events.paint :as paint-events]
|
||||||
[arthur.events.playback :as pb]
|
[arthur.events.playback :as pb]
|
||||||
|
|
@ -123,6 +124,16 @@
|
||||||
:else (let [v (:value ch)]
|
:else (let [v (:value ch)]
|
||||||
(str "framed · " (if (channel/nothing? v) "absent" (pr-str v))))))
|
(str "framed · " (if (channel/nothing? v) "absent" (pr-str v))))))
|
||||||
|
|
||||||
|
(defn- segment-select
|
||||||
|
"Hold or tween, for the gap after the key at `left` — the same choice on a
|
||||||
|
drawing as on a transform."
|
||||||
|
[sid id path ch left]
|
||||||
|
[:select.interp {:value (name (or (channel/segment-interp ch left) :hold))
|
||||||
|
:on-change #(rf/dispatch [::project/set-segment-interp
|
||||||
|
sid id path left (keyword (.. % -target -value))])}
|
||||||
|
[:option {:value "hold"} "hold"]
|
||||||
|
[:option {:value "linear"} "tween"]])
|
||||||
|
|
||||||
(defn- drawing-keys
|
(defn- drawing-keys
|
||||||
"The polygon controls: jump to a drawing key, add one here, and choose what the
|
"The polygon controls: jump to a drawing key, add one here, and choose what the
|
||||||
gap after the current one does. Lifted out of the old stage toolbar unchanged —
|
gap after the current one does. Lifted out of the old stage toolbar unchanged —
|
||||||
|
|
@ -158,23 +169,23 @@
|
||||||
(when next-k
|
(when next-k
|
||||||
[:div.row {:style {:margin-top "5px"}}
|
[:div.row {:style {:margin-top "5px"}}
|
||||||
[:label.dim (str "key " active " → " next-k " ")
|
[:label.dim (str "key " active " → " next-k " ")
|
||||||
[:select {:value (name (or (channel/segment-interp geom active) :hold))
|
[segment-select sid id paint/geometry geom active]]])]))
|
||||||
:on-change #(rf/dispatch [::paint-events/set-segment-interp
|
|
||||||
sid id active (keyword (.. % -target -value))])}
|
|
||||||
[:option {:value "hold"} "hold"]
|
|
||||||
[:option {:value "linear"} "tween"]]]])]))
|
|
||||||
|
|
||||||
;; The transform and visibility, which every node has, as one row each: ◆ keys
|
;; The transform and visibility, which every node has, as one row each: ◆ keys
|
||||||
;; the channel here or takes the key here off, and an edit writes a key on a
|
;; the channel here or takes the key here off, and an edit writes a key on a
|
||||||
;; keyed channel or the one value on one that is not. `frame` is the node's own,
|
;; keyed channel or the one value on one that is not. `frame` is the node's own,
|
||||||
;; nil when it is not on screen, where a keyed channel has no here to write to.
|
;; nil when it is not on screen, where a keyed channel has no here to write to.
|
||||||
;; Rotation is shown in degrees.
|
;; Rotation is shown in degrees. Between two keys, the gap after the one here
|
||||||
|
;; holds or tweens, as a drawing's does.
|
||||||
|
|
||||||
(defn- channel-control [sid id path ch frame]
|
(defn- channel-control [sid id path ch frame]
|
||||||
(let [keyed? (some? (:keys ch))
|
(let [keyed? (some? (:keys ch))
|
||||||
v (channel/value-at ch (or frame 0))
|
v (channel/value-at ch (or frame 0))
|
||||||
off? (and keyed? (nil? frame))
|
off? (and keyed? (nil? frame))
|
||||||
deg? (= path [:xform :rot])
|
deg? (= path [:xform :rot])
|
||||||
|
;; A boolean has nothing between true and false to tween through.
|
||||||
|
left (when (and keyed? frame (not (boolean? v))) (paint/active-frame ch frame))
|
||||||
|
gap? (and left (some #(< left %) (keys (:keys ch))))
|
||||||
put #(rf/dispatch [::project/set-channel sid id path frame %])
|
put #(rf/dispatch [::project/set-channel sid id path frame %])
|
||||||
field (fn [i x on-number]
|
field (fn [i x on-number]
|
||||||
^{:key i}
|
^{:key i}
|
||||||
|
|
@ -193,7 +204,8 @@
|
||||||
:on-change #(put (.. % -target -checked))}]
|
:on-change #(put (.. % -target -checked))}]
|
||||||
(number? v) (field 0 v put)
|
(number? v) (field 0 v put)
|
||||||
:else (doall (map-indexed (fn [i x] (field i x #(put (assoc (vec v) i %))))
|
:else (doall (map-indexed (fn [i x] (field i x #(put (assoc (vec v) i %))))
|
||||||
v)))]))
|
v)))
|
||||||
|
(when gap? [segment-select sid id path ch left])]))
|
||||||
|
|
||||||
(defn- node-section [[sid id n]]
|
(defn- node-section [[sid id n]]
|
||||||
(let [[start end] (:span n)]
|
(let [[start end] (:span n)]
|
||||||
|
|
@ -217,10 +229,76 @@
|
||||||
^{:key (str path)}
|
^{:key (str path)}
|
||||||
[:<>
|
[:<>
|
||||||
[:dt (str/join " " (map name path))]
|
[:dt (str/join " " (map name path))]
|
||||||
(if (and (contains? node/defaults path) (not (:dense ch)))
|
(if (and (contains? (node/defaults-of n) path) (not (:dense ch)))
|
||||||
[channel-control sid id path ch frame]
|
[channel-control sid id path ch frame]
|
||||||
[:dd (channel-state ch)])]))])]))
|
[:dd (channel-state ch)])]))])]))
|
||||||
|
|
||||||
|
;; ---------------------------------------------------------------------------
|
||||||
|
;; tracing a face
|
||||||
|
;;
|
||||||
|
;; Two owners in one section, and the heading says whose each is. Showing the
|
||||||
|
;; footage and how strongly is this INSTANCE's, a drawing aid that is not keyed,
|
||||||
|
;; and it covers every face at or below it — so a take shows its faces' footage.
|
||||||
|
;; The trace keys and the origin are the FACE's — its symbol's head — so they are
|
||||||
|
;; the same in every placement of it. See `domain/trace`.
|
||||||
|
|
||||||
|
(defn- face-trace [face]
|
||||||
|
(let [t (trace/of (get-in @(rf/subscribe [::render/clip]) [:symbols face :nodes :head]))
|
||||||
|
{:keys [frame time]} @(rf/subscribe [::sub/selected-local])
|
||||||
|
put #(rf/dispatch [::project/set-trace face %])]
|
||||||
|
[:<>
|
||||||
|
[:div.row {:style {:margin "5px 0"}}
|
||||||
|
[:button {:disabled (nil? frame)
|
||||||
|
:on-click #(put (trace/toggle-frame t frame))}
|
||||||
|
(if (some #{frame} (:frames t)) "remove trace key" "trace key here")]]
|
||||||
|
(when (seq (:frames t))
|
||||||
|
[:div.row
|
||||||
|
[:span.dim "keys"]
|
||||||
|
(doall
|
||||||
|
(for [f (:frames t)]
|
||||||
|
^{:key f}
|
||||||
|
[:button {:class (when (= frame f) "on")
|
||||||
|
:disabled (nil? time)
|
||||||
|
:on-click #(rf/dispatch [::pb/seek (js/Math.round
|
||||||
|
(+ (:at time) (/ f (:rate time))))])}
|
||||||
|
(str f)]))])
|
||||||
|
[:div.row {:style {:margin-top "5px"}}
|
||||||
|
[:span.dim "origin"]
|
||||||
|
(doall
|
||||||
|
(for [[o label] (map vector trace/origins ["continuous" "at keys" "start"])]
|
||||||
|
^{:key o}
|
||||||
|
[:button {:class (when (= o (:origin t)) "on")
|
||||||
|
:on-click #(put (assoc t :origin o))}
|
||||||
|
label]))]]))
|
||||||
|
|
||||||
|
(defn- tracing-section [[sid id n] faces]
|
||||||
|
(let [clip @(rf/subscribe [::render/clip])
|
||||||
|
open @(rf/subscribe [::render/open])
|
||||||
|
[_ _ _ path] @(rf/subscribe [::sub/selection])
|
||||||
|
path (or path [id])
|
||||||
|
{:keys [on? opacity own?] :or {opacity 0.5} :as u} (trace/underlay-at clip open path)
|
||||||
|
show #(rf/dispatch [::project/set-underlay sid id (merge {:on? (boolean on?) :opacity opacity} %)])]
|
||||||
|
[section (str "tracing · " (name (:of n)))
|
||||||
|
[:div.row
|
||||||
|
[:label.dim [:input {:type "checkbox" :checked (boolean on?)
|
||||||
|
:on-change #(show {:on? (.. % -target -checked)})}]
|
||||||
|
" footage"
|
||||||
|
(when (and u (not own?)) " · as above")]
|
||||||
|
[:input {:type "range" :min 0 :max 1 :step 0.05 :value opacity
|
||||||
|
:disabled (not on?)
|
||||||
|
:on-focus #(rf/dispatch [::history/hold])
|
||||||
|
:on-blur #(rf/dispatch [::history/settle])
|
||||||
|
:on-change #(show {:opacity (js/parseFloat (.. % -target -value))})}]]
|
||||||
|
(when (trace/traceable? clip (:of n)) [face-trace (:of n)])
|
||||||
|
(when (seq faces)
|
||||||
|
[:div.row {:style {:margin-top "5px"}}
|
||||||
|
[:span.dim "faces"]
|
||||||
|
(doall
|
||||||
|
(for [{p :path in :in face :face} faces]
|
||||||
|
^{:key (str p)}
|
||||||
|
[:button {:on-click #(rf/dispatch [::ui/select [:node in (peek p) (into path p)]])}
|
||||||
|
(name face)]))])]))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; a symbol
|
;; a symbol
|
||||||
|
|
||||||
|
|
@ -346,5 +424,9 @@
|
||||||
[:div {:style {:min-height 0}}
|
[:div {:style {:min-height 0}}
|
||||||
[clip-section]
|
[clip-section]
|
||||||
(when node [node-section node])
|
(when node [node-section node])
|
||||||
|
(when-let [of (:of (peek node))]
|
||||||
|
(let [faces (trace/faces clip of)]
|
||||||
|
(when (or (trace/traceable? clip of) (seq faces))
|
||||||
|
[tracing-section node faces])))
|
||||||
(when (= :symbol (first selection)) [symbol-section (second selection)])
|
(when (= :symbol (first selection)) [symbol-section (second selection)])
|
||||||
(when tracked? [tracking-section])]]))
|
(when tracked? [tracking-section])]]))
|
||||||
|
|
|
||||||
|
|
@ -19,11 +19,13 @@
|
||||||
times a second at a 30fps clip on a 60Hz display, not sixty — and it carries
|
times a second at a 30fps clip on a 60Hz display, not sixty — and it carries
|
||||||
no global interceptors."
|
no global interceptors."
|
||||||
(:require [arthur.clock :as clock]
|
(:require [arthur.clock :as clock]
|
||||||
|
[arthur.domain.pick :as pick]
|
||||||
[arthur.domain.raster :as raster]
|
[arthur.domain.raster :as raster]
|
||||||
[arthur.events.playback :as pb]
|
[arthur.events.playback :as pb]
|
||||||
[arthur.subs.playback :as sub]
|
[arthur.subs.playback :as sub]
|
||||||
[arthur.subs.render :as render]
|
[arthur.subs.render :as render]
|
||||||
[arthur.ui.canvas :as canvas]
|
[arthur.ui.canvas :as canvas]
|
||||||
|
[arthur.ui.underlay :as underlay]
|
||||||
[re-frame.core :as rf]
|
[re-frame.core :as rf]
|
||||||
[reagent.ratom :as ratom]))
|
[reagent.ratom :as ratom]))
|
||||||
|
|
||||||
|
|
@ -109,6 +111,7 @@
|
||||||
:frames @(rf/subscribe [::render/frames])
|
:frames @(rf/subscribe [::render/frames])
|
||||||
:width @(rf/subscribe [::sub/width])
|
:width @(rf/subscribe [::sub/width])
|
||||||
:height @(rf/subscribe [::sub/height])
|
:height @(rf/subscribe [::sub/height])
|
||||||
|
:underlay @(rf/subscribe [::render/underlay])
|
||||||
:frame @(rf/subscribe [::sub/frame])
|
:frame @(rf/subscribe [::sub/frame])
|
||||||
:playing? @(rf/subscribe [::sub/playing?])})
|
:playing? @(rf/subscribe [::sub/playing?])})
|
||||||
;; A new resolver means a new scene or a new palette, and neither
|
;; A new resolver means a new scene or a new palette, and neither
|
||||||
|
|
@ -129,13 +132,21 @@
|
||||||
raster
|
raster
|
||||||
(:raster (swap! state assoc :raster (raster/make w h))))))
|
(:raster (swap! state assoc :raster (raster/make w h))))))
|
||||||
|
|
||||||
|
(defn at
|
||||||
|
"The topmost row path drawn at stage point `point` on the frame last painted,
|
||||||
|
or nil. Read off the ops the canvas was drawn from, so a click picks exactly
|
||||||
|
what is seen: their point buffers stay good until the next paint, and a
|
||||||
|
pointer event is handled between two."
|
||||||
|
[point]
|
||||||
|
(pick/hit (:ops @state) point))
|
||||||
|
|
||||||
(defn paint!
|
(defn paint!
|
||||||
"Resolve `f` and put it on the canvas. `ops` are consumed here and only here —
|
"Resolve `f` and put it on the canvas. `ops` are consumed here and only here —
|
||||||
the resolver reuses its point buffers between frames, so they have to be
|
the resolver reuses its point buffers between frames, so they have to be
|
||||||
rasterised before the next frame is asked for."
|
rasterised before the next frame is asked for."
|
||||||
[f]
|
[f]
|
||||||
(let [{:keys [canvas]} @state
|
(let [{:keys [canvas]} @state
|
||||||
{:keys [resolver palette ramp width height]} @snapshot]
|
{:keys [resolver palette ramp width height underlay]} @snapshot]
|
||||||
(when (and canvas resolver width height)
|
(when (and canvas resolver width height)
|
||||||
;; User Timing, so a profile in the DevTools performance panel has named
|
;; User Timing, so a profile in the DevTools performance panel has named
|
||||||
;; spans in the Timings track instead of a wall of anonymous frames. Three
|
;; spans in the Timings track instead of a wall of anonymous frames. Three
|
||||||
|
|
@ -145,11 +156,14 @@
|
||||||
;; independent of the footage, so the size the frame is rasterised at comes
|
;; independent of the footage, so the size the frame is rasterised at comes
|
||||||
;; out of the document like everything else.
|
;; out of the document like everything else.
|
||||||
(let [ras (raster-for width height)]
|
(let [ras (raster-for width height)]
|
||||||
(-> ras
|
(let [ops (resolver f)]
|
||||||
(raster/clear! (get palette :bg 0))
|
(swap! state assoc :ops ops)
|
||||||
(raster/draw-ops! (resolver f)))
|
(-> ras
|
||||||
|
(raster/clear! (get palette :bg 0))
|
||||||
|
(raster/draw-ops! ops)))
|
||||||
(js/performance.mark "arthur/blit:start")
|
(js/performance.mark "arthur/blit:start")
|
||||||
(canvas/blit! canvas ras ramp))
|
(canvas/blit! canvas ras ramp)
|
||||||
|
(underlay/paint! (assoc underlay :width width) resolver repaint!))
|
||||||
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
|
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
|
||||||
(js/performance.measure "arthur/paint" "arthur/paint:start")
|
(js/performance.measure "arthur/paint" "arthur/paint:start")
|
||||||
;; User Timing entries otherwise accumulate forever in the browser's
|
;; User Timing entries otherwise accumulate forever in the browser's
|
||||||
|
|
|
||||||
|
|
@ -13,6 +13,9 @@
|
||||||
one of another's, and `footage:<id>` for video. The stage and the timeline are
|
one of another's, and `footage:<id>` for video. The stage and the timeline are
|
||||||
where they are dropped.
|
where they are dropped.
|
||||||
|
|
||||||
|
A SOUND — mp3, wav — is `sound:<id>`, and is dropped on the timeline, where it
|
||||||
|
becomes an audio node in the open symbol from the frame it lands on.
|
||||||
|
|
||||||
THE WHOLE PANE IS THE DROP TARGET for a file. A video dropped anywhere in it
|
THE WHOLE PANE IS THE DROP TARGET for a file. A video dropped anywhere in it
|
||||||
uploads and lands in THIS PROJECT's media, and goes no further: which frames of
|
uploads and lands in THIS PROJECT's media, and goes no further: which frames of
|
||||||
it become a symbol, and what that symbol is called, is asked when it is dropped
|
it become a symbol, and what that symbol is called, is asked when it is dropped
|
||||||
|
|
@ -78,6 +81,21 @@
|
||||||
#(drag/other! {:kind :footage :id id :label label
|
#(drag/other! {:kind :footage :id id :label label
|
||||||
:frames frames :fps fps :video video})))])
|
:frames frames :fps fps :video video})))])
|
||||||
|
|
||||||
|
(defn- sound-row
|
||||||
|
"An uploaded sound, or with `:footage?` a video's own — which is how a take's
|
||||||
|
sound goes back into its symbol after it was deleted there."
|
||||||
|
[{:keys [id label duration footage? fps]} project-fps]
|
||||||
|
(let [frames (js/Math.ceil (* duration project-fps))
|
||||||
|
[source length rate] (if footage?
|
||||||
|
[{:footage id} (js/Math.round (* duration fps)) (/ fps project-fps)]
|
||||||
|
[{:sound id} frames 1])]
|
||||||
|
[item (merge {:label label
|
||||||
|
:sub (str (.toFixed duration 1) "s · " frames "f")
|
||||||
|
:thumb [:span.thumb.sound "♪"]}
|
||||||
|
(carrying (str "sound:" id)
|
||||||
|
#(drag/other! {:kind :sound :source source :label label
|
||||||
|
:length length :rate rate :frames frames})))]))
|
||||||
|
|
||||||
(defn- folder [title & children]
|
(defn- folder [title & children]
|
||||||
(into [:details.pool-folder {:open true} [:summary title]] children))
|
(into [:details.pool-folder {:open true} [:summary title]] children))
|
||||||
|
|
||||||
|
|
@ -90,6 +108,12 @@
|
||||||
selection @(rf/subscribe [::sub/selection])
|
selection @(rf/subscribe [::sub/selection])
|
||||||
open @(rf/subscribe [::render/open])
|
open @(rf/subscribe [::render/open])
|
||||||
media @(rf/subscribe [::sub/project-footage])
|
media @(rf/subscribe [::sub/project-footage])
|
||||||
|
;; The project's videos' sounds first, then its uploaded ones.
|
||||||
|
sounds (into (mapv (fn [{:keys [id label frames fps]}]
|
||||||
|
{:id id :label label :footage? true :fps fps
|
||||||
|
:duration (/ frames fps)})
|
||||||
|
media)
|
||||||
|
@(rf/subscribe [::sub/project-sounds]))
|
||||||
{:keys [chosen]} @(rf/subscribe [::playback/footage])]
|
{:keys [chosen]} @(rf/subscribe [::playback/footage])]
|
||||||
(folder "this project"
|
(folder "this project"
|
||||||
(group "symbols"
|
(group "symbols"
|
||||||
|
|
@ -109,10 +133,15 @@
|
||||||
(group "media"
|
(group "media"
|
||||||
(if (empty? media)
|
(if (empty? media)
|
||||||
[:div.dim "drop a video here"]
|
[:div.dim "drop a video here"]
|
||||||
(doall (for [f media] ^{:key (:id f)} [footage-row f chosen])))))))
|
(doall (for [f media] ^{:key (:id f)} [footage-row f chosen]))))
|
||||||
|
(group "sounds"
|
||||||
|
(if (empty? sounds)
|
||||||
|
[:div.dim "drop an mp3 or wav here"]
|
||||||
|
(doall (for [s sounds] ^{:key (:id s)} [sound-row s (:fps document)])))))))
|
||||||
|
|
||||||
(defn- all-assets []
|
(defn- all-assets []
|
||||||
(let [{:keys [available chosen]} @(rf/subscribe [::playback/footage])
|
(let [{:keys [available chosen sounds]} @(rf/subscribe [::playback/footage])
|
||||||
|
fps (:fps @(rf/subscribe [::render/clip]))
|
||||||
{:keys [symbols]} @(rf/subscribe [::project/assets])
|
{:keys [symbols]} @(rf/subscribe [::project/assets])
|
||||||
{:keys [id]} @(rf/subscribe [::playback/project])]
|
{:keys [id]} @(rf/subscribe [::playback/project])]
|
||||||
(folder "all assets"
|
(folder "all assets"
|
||||||
|
|
@ -120,6 +149,10 @@
|
||||||
(if (empty? available)
|
(if (empty? available)
|
||||||
[:div.dim "nothing uploaded yet"]
|
[:div.dim "nothing uploaded yet"]
|
||||||
(doall (for [f available] ^{:key (:id f)} [footage-row f chosen]))))
|
(doall (for [f available] ^{:key (:id f)} [footage-row f chosen]))))
|
||||||
|
(group "sounds"
|
||||||
|
(if (empty? sounds)
|
||||||
|
[:div.dim "no sounds uploaded yet"]
|
||||||
|
(doall (for [s sounds] ^{:key (:id s)} [sound-row s fps]))))
|
||||||
(group "symbols"
|
(group "symbols"
|
||||||
(let [others (remove #(= id (:project %)) symbols)]
|
(let [others (remove #(= id (:project %)) symbols)]
|
||||||
(if (empty? others)
|
(if (empty? others)
|
||||||
|
|
@ -165,11 +198,11 @@
|
||||||
[:div.pane-head
|
[:div.pane-head
|
||||||
"media pool"
|
"media pool"
|
||||||
[:span.spacer]
|
[:span.spacer]
|
||||||
[:button {:title "add a video"
|
[:button {:title "add a video or a sound"
|
||||||
:disabled loading?
|
:disabled loading?
|
||||||
:on-click #(.click (js/document.getElementById "pool-file"))}
|
:on-click #(.click (js/document.getElementById "pool-file"))}
|
||||||
"+"]]
|
"+"]]
|
||||||
[:input {:id "pool-file" :type "file" :accept "video/*"
|
[:input {:id "pool-file" :type "file" :accept "video/*,audio/*"
|
||||||
:style {:display "none"}
|
:style {:display "none"}
|
||||||
:on-change (fn [^js event]
|
:on-change (fn [^js event]
|
||||||
(when-let [file (aget (.. event -target -files) 0)]
|
(when-let [file (aget (.. event -target -files) 0)]
|
||||||
|
|
|
||||||
|
|
@ -9,6 +9,7 @@
|
||||||
[arthur.ui.convert :as convert]
|
[arthur.ui.convert :as convert]
|
||||||
[arthur.events.playback :as pb]
|
[arthur.events.playback :as pb]
|
||||||
[arthur.subs.playback :as playback]
|
[arthur.subs.playback :as playback]
|
||||||
|
[arthur.subs.render :as render]
|
||||||
[arthur.ui.palette :as palette]
|
[arthur.ui.palette :as palette]
|
||||||
[arthur.ui.params :as params]
|
[arthur.ui.params :as params]
|
||||||
[arthur.ui.pool :as pool]
|
[arthur.ui.pool :as pool]
|
||||||
|
|
@ -16,19 +17,31 @@
|
||||||
[arthur.ui.tabs :as tabs]
|
[arthur.ui.tabs :as tabs]
|
||||||
[arthur.ui.timeline :as timeline]
|
[arthur.ui.timeline :as timeline]
|
||||||
[arthur.ui.topbar :as topbar]
|
[arthur.ui.topbar :as topbar]
|
||||||
[re-frame.core :as rf]))
|
[re-frame.core :as rf]
|
||||||
|
[reagent.core :as r]))
|
||||||
|
|
||||||
(defn- audio []
|
(defn- audio []
|
||||||
[:audio
|
;; An edit to what the open symbol plays — a sound dropped, moved, turned
|
||||||
{:ref #(when % (clock/attach! %))
|
;; down, undone — re-mixes the clock. Opening a symbol mixes on its own, so
|
||||||
:src @(rf/subscribe [::playback/audio])
|
;; only a change under the same one counts.
|
||||||
:preload "auto"
|
(r/with-let [heard (atom nil)
|
||||||
;; Transport state follows the ELEMENT, not the other way round: the audio is
|
remix (r/track! (fn []
|
||||||
;; the clock, so anything that can change its state — the end of the file, the
|
(let [[sid :as now] @(rf/subscribe [::render/sounds])
|
||||||
;; OS media keys, a browser autoplay block — has to be able to correct the
|
[was :as before] @heard]
|
||||||
;; document rather than be contradicted by it.
|
(reset! heard now)
|
||||||
:on-play #(rf/dispatch [::pb/play])
|
(when (and before (= sid was) (not= now before))
|
||||||
:on-pause #(rf/dispatch [::pb/pause])}])
|
(rf/dispatch [::pb/refresh-clock])))))]
|
||||||
|
[:audio
|
||||||
|
{:ref #(when % (clock/attach! %))
|
||||||
|
:src @(rf/subscribe [::playback/audio])
|
||||||
|
:preload "auto"
|
||||||
|
;; Transport state follows the ELEMENT, not the other way round: the audio is
|
||||||
|
;; the clock, so anything that can change its state — the end of the file, the
|
||||||
|
;; OS media keys, a browser autoplay block — has to be able to correct the
|
||||||
|
;; document rather than be contradicted by it.
|
||||||
|
:on-play #(rf/dispatch [::pb/play])
|
||||||
|
:on-pause #(rf/dispatch [::pb/pause])}]
|
||||||
|
(finally (r/dispose! remix))))
|
||||||
|
|
||||||
(defn view []
|
(defn view []
|
||||||
[:div.app
|
[:div.app
|
||||||
|
|
|
||||||
|
|
@ -10,16 +10,20 @@
|
||||||
THE CANVAS IS THE RASTER'S OWN SIZE, scaled by CSS. See `ui/canvas` for why
|
THE CANVAS IS THE RASTER'S OWN SIZE, scaled by CSS. See `ui/canvas` for why
|
||||||
that is load-bearing rather than convenient."
|
that is load-bearing rather than convenient."
|
||||||
(:require [arthur.domain.channel :as channel]
|
(:require [arthur.domain.channel :as channel]
|
||||||
|
[arthur.domain.gesture :as gesture]
|
||||||
[arthur.domain.nest :as nest]
|
[arthur.domain.nest :as nest]
|
||||||
[arthur.domain.node :as node]
|
[arthur.domain.node :as node]
|
||||||
[arthur.domain.paint :as paint]
|
[arthur.domain.paint :as paint]
|
||||||
|
[arthur.domain.pick :as pick]
|
||||||
[arthur.events.paint :as paint-events]
|
[arthur.events.paint :as paint-events]
|
||||||
[arthur.events.ui :as ui]
|
[arthur.events.ui :as ui]
|
||||||
|
[arthur.footage.store :as store]
|
||||||
[arthur.subs.playback :as playback]
|
[arthur.subs.playback :as playback]
|
||||||
[arthur.subs.render :as render]
|
[arthur.subs.render :as render]
|
||||||
[arthur.subs.ui :as sub]
|
[arthur.subs.ui :as sub]
|
||||||
[arthur.ui.drag :as drag]
|
[arthur.ui.drag :as drag]
|
||||||
[arthur.ui.player :as player]
|
[arthur.ui.player :as player]
|
||||||
|
[arthur.ui.underlay :as underlay]
|
||||||
[re-frame.core :as rf]))
|
[re-frame.core :as rf]))
|
||||||
|
|
||||||
(def ^:const zoom
|
(def ^:const zoom
|
||||||
|
|
@ -101,49 +105,181 @@
|
||||||
[:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 5)
|
[:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 5)
|
||||||
" M " cx " " (- cy 5) " V " (+ cy 5))}]]))))
|
" M " cx " " (- cy 5) " V " (+ cy 5))}]]))))
|
||||||
|
|
||||||
|
(defn- xy
|
||||||
|
"Where a pointer event is, in stage pixels, unrounded and unclamped: a drag
|
||||||
|
holding the pointer may leave the stage and still be moving something."
|
||||||
|
[^js svg event w h]
|
||||||
|
(let [box (.getBoundingClientRect svg)]
|
||||||
|
[(/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
|
||||||
|
(/ (* (- (.-clientY event) (.-top box)) h) (.-height box))]))
|
||||||
|
|
||||||
|
;; The move, turn or scale being dragged, as `dragging` is for a vertex: the
|
||||||
|
;; placement and transform it started from, and where. What it makes of the
|
||||||
|
;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`.
|
||||||
|
(defonce ^:private gesture (atom nil))
|
||||||
|
|
||||||
|
(defn- select!
|
||||||
|
"Select the node at row path `path` of the open symbol — the selection a
|
||||||
|
timeline row makes, so the row, the inspector and the stage all show it — or
|
||||||
|
nothing."
|
||||||
|
[{:keys [document st open f]} path]
|
||||||
|
(rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path)
|
||||||
|
(nest/placement document st open path f))]
|
||||||
|
[:node sid id path])]))
|
||||||
|
|
||||||
|
(defn- begin!
|
||||||
|
"Start dragging `kind` of the node at `path` from stage point `p`."
|
||||||
|
[{:keys [document st open f]} kind path p]
|
||||||
|
(when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)]
|
||||||
|
(let [n (get-in document [:symbols sid :nodes id])
|
||||||
|
v0 (gesture/values n frame)]
|
||||||
|
(reset! gesture {:kind kind :pl pl :v0 v0 :p0 p :n n
|
||||||
|
:a (gesture/angle pl v0 p) :turned 0}))))
|
||||||
|
|
||||||
|
(defn- drag! [p ^js event]
|
||||||
|
(let [{:keys [kind pl v0 p0 n a turned values]} @gesture
|
||||||
|
shift? (.-shiftKey event)
|
||||||
|
moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))]
|
||||||
|
(when moved?
|
||||||
|
(if-let [why (gesture/refusal n)]
|
||||||
|
(do (reset! gesture nil) (rf/dispatch [::ui/refuse why]))
|
||||||
|
(let [vs (case kind
|
||||||
|
:move (gesture/move pl v0 p0 p)
|
||||||
|
:scale (gesture/scale pl v0 p0 p shift?)
|
||||||
|
:turn (let [b (gesture/angle pl v0 p)
|
||||||
|
d (- b a)
|
||||||
|
t (+ turned (- d (* 2 js/Math.PI (js/Math.round (/ d (* 2 js/Math.PI))))))
|
||||||
|
q (/ js/Math.PI 12)]
|
||||||
|
(swap! gesture assoc :a b :turned t)
|
||||||
|
;; ⇧ turns in 15° steps, as everywhere.
|
||||||
|
(gesture/turn v0 (if shift?
|
||||||
|
(- (* q (js/Math.round (/ (+ (:rot v0) t) q))) (:rot v0))
|
||||||
|
t))))]
|
||||||
|
(when vs
|
||||||
|
(swap! gesture assoc :values vs)
|
||||||
|
(rf/dispatch [::ui/gesture (assoc (select-keys pl [:sid :id :frame]) :values vs)])))))))
|
||||||
|
|
||||||
|
(defn- let-go! [commit?]
|
||||||
|
(when-let [{:keys [pl values]} @gesture]
|
||||||
|
(reset! gesture nil)
|
||||||
|
(when values
|
||||||
|
(rf/dispatch (if commit?
|
||||||
|
[::ui/transform (assoc (select-keys pl [:sid :id :frame]) :values values)]
|
||||||
|
[::ui/gesture nil])))))
|
||||||
|
|
||||||
|
(defn- handles
|
||||||
|
"The selected node's box, drawn through its own transform so it turns with
|
||||||
|
it: a square on each corner to scale by, a knob above to turn by, and a cross
|
||||||
|
on the pivot. Dragging inside it moves it — that is the stage's own
|
||||||
|
pointerdown, which keeps a selection it lands inside."
|
||||||
|
[ctx]
|
||||||
|
(let [{:keys [world bounds node frame]} @(rf/subscribe [::sub/selected-placement])
|
||||||
|
[_ _ _ path] @(rf/subscribe [::sub/selection])
|
||||||
|
[ax ay] (when world (:anchor (gesture/values node frame)))
|
||||||
|
[px py] (when world (through world [ax ay]))
|
||||||
|
grab (fn [kind]
|
||||||
|
(fn [^js event]
|
||||||
|
(.stopPropagation event)
|
||||||
|
(.preventDefault event)
|
||||||
|
(let [svg (.-ownerSVGElement (.-currentTarget event))]
|
||||||
|
(.setPointerCapture svg (.-pointerId event))
|
||||||
|
(begin! ctx kind path (xy svg event (:w ctx) (:h ctx))))))]
|
||||||
|
(when world
|
||||||
|
[:g.handles
|
||||||
|
(when-let [[x0 y0 x1 y1] bounds]
|
||||||
|
(let [corners (partition 2 (through world [x0 y0 x1 y0 x1 y1 x0 y1]))
|
||||||
|
[cx cy tx ty] (through world [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2) (/ (+ x0 x1) 2) y0])
|
||||||
|
len (max 1e-6 (js/Math.hypot (- tx cx) (- ty cy)))
|
||||||
|
[kx ky] [(+ tx (* 8 (/ (- tx cx) len))) (+ ty (* 8 (/ (- ty cy) len)))]]
|
||||||
|
[:<>
|
||||||
|
[:polygon.box {:points (points-text (flatten corners))}]
|
||||||
|
[:line.knob-arm {:x1 tx :y1 ty :x2 kx :y2 ky}]
|
||||||
|
[:circle.knob {:cx kx :cy ky :r 2.2 :on-pointer-down (grab :turn)}]
|
||||||
|
(doall
|
||||||
|
(for [[i [x y]] (map-indexed vector corners)]
|
||||||
|
^{:key i}
|
||||||
|
[:rect.corner {:x (- x 1.8) :y (- y 1.8) :width 3.6 :height 3.6
|
||||||
|
:on-pointer-down (grab :scale)}]))]))
|
||||||
|
[:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3)
|
||||||
|
" M " px " " (- py 3) " V " (+ py 3))}]])))
|
||||||
|
|
||||||
(defn- overlay [w h]
|
(defn- overlay [w h]
|
||||||
(let [tool @(rf/subscribe [::sub/tool])
|
(let [tool @(rf/subscribe [::sub/tool])
|
||||||
draft @(rf/subscribe [::sub/draft])
|
draft @(rf/subscribe [::sub/draft])
|
||||||
drawing? (= :polygon tool)
|
drawing? (= :polygon tool)
|
||||||
[sid id geom active editable? frame matrix] (editing)
|
[_ _ _ selected] @(rf/subscribe [::sub/selection])
|
||||||
|
clip-id @(rf/subscribe [::render/clip-id])
|
||||||
|
ctx {:document (:clip (store/entry clip-id)) :st (:store (store/entry clip-id))
|
||||||
|
:open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::playback/frame])
|
||||||
|
:w w :h h}
|
||||||
|
points? @(rf/subscribe [::sub/points])
|
||||||
|
[sid id geom active editable? frame matrix] (when points? (editing))
|
||||||
pts (when geom (through matrix (channel/value-at geom frame)))]
|
pts (when geom (through matrix (channel/value-at geom frame)))]
|
||||||
[:svg {:class (str "paint-overlay" (when drawing? " drawing"))
|
[:svg {:class (str "paint-overlay" (when drawing? " drawing"))
|
||||||
:width (* zoom w) :height (* zoom h)
|
:width (* zoom w) :height (* zoom h)
|
||||||
:view-box (str "0 0 " w " " h)
|
:view-box (str "0 0 " w " " h)
|
||||||
:on-pointer-down (fn [event]
|
:tab-index -1
|
||||||
(when drawing?
|
:on-pointer-down (fn [^js event]
|
||||||
|
(if drawing?
|
||||||
(let [[x y] (stage-point event w h)]
|
(let [[x y] (stage-point event w h)]
|
||||||
(rf/dispatch [::ui/add-draft-point x y]))))
|
(rf/dispatch [::ui/add-draft-point x y]))
|
||||||
|
(let [svg (.-currentTarget event)
|
||||||
|
p (xy svg event w h)
|
||||||
|
path (pick/choose selected (player/at p)
|
||||||
|
(or (.-metaKey event) (.-ctrlKey event)))]
|
||||||
|
(.focus svg)
|
||||||
|
(when (not= path selected) (select! ctx path))
|
||||||
|
(when path
|
||||||
|
(.setPointerCapture svg (.-pointerId event))
|
||||||
|
(begin! ctx :move path p)))))
|
||||||
|
:on-double-click (fn [^js event]
|
||||||
|
(when-not drawing?
|
||||||
|
(let [p (xy (.-currentTarget event) event w h)
|
||||||
|
hit (player/at p)
|
||||||
|
path (pick/deeper selected hit)]
|
||||||
|
(cond
|
||||||
|
(not= path selected) (select! ctx path)
|
||||||
|
(= hit selected) (rf/dispatch [::ui/points true])))))
|
||||||
|
:on-key-down (fn [^js event]
|
||||||
|
;; Out a level, as Figma's Esc: the instance that
|
||||||
|
;; holds what is selected, then nothing.
|
||||||
|
(when (and (= "Escape" (.-key event)) selected (not drawing?))
|
||||||
|
(if points?
|
||||||
|
(rf/dispatch [::ui/points false])
|
||||||
|
(select! ctx (pop selected)))))
|
||||||
:on-pointer-move (fn [event]
|
:on-pointer-move (fn [event]
|
||||||
;; Back through the inverse of what the handle was
|
;; Back through the inverse of what the handle was
|
||||||
;; drawn through, into the shape's own coordinates.
|
;; drawn through, into the shape's own coordinates.
|
||||||
(when-let [[sid node key-frame vertex inv] @dragging]
|
(if-let [[sid node key-frame vertex inv] @dragging]
|
||||||
(rf/dispatch [::paint-events/set-vertex
|
(rf/dispatch [::paint-events/set-vertex
|
||||||
sid node key-frame vertex
|
sid node key-frame vertex
|
||||||
(through inv (stage-point event w h))])))
|
(through inv (stage-point event w h))])
|
||||||
:on-pointer-up (fn [_] (reset! dragging nil))
|
(when @gesture
|
||||||
:on-pointer-cancel (fn [_] (reset! dragging nil))}
|
(drag! (xy (.-currentTarget event) event w h) event))))
|
||||||
|
:on-pointer-up (fn [_] (reset! dragging nil) (let-go! true))
|
||||||
|
:on-pointer-cancel (fn [_] (reset! dragging nil) (let-go! false))}
|
||||||
[ghost]
|
[ghost]
|
||||||
(when (seq draft)
|
(when (seq draft)
|
||||||
[:polyline {:points (points-text draft) :fill "none"
|
[:polyline {:points (points-text draft) :fill "none"
|
||||||
:stroke "#d0ba86" :stroke-width 1}])
|
:stroke "#d0ba86" :stroke-width 1}])
|
||||||
|
(when-not (or drawing? points?) [handles ctx])
|
||||||
(when (and id pts (not drawing?) (not (channel/nothing? pts)))
|
(when (and id pts (not drawing?) (not (channel/nothing? pts)))
|
||||||
[:g
|
[:g
|
||||||
[:polygon {:points (points-text pts) :fill "none"
|
[:polygon {:points (points-text pts) :fill "none"
|
||||||
:stroke "#e6ca8b" :stroke-width 1}]
|
:stroke "#e6ca8b" :stroke-width 1}]
|
||||||
(when-let [inv (when editable? (nest/invert matrix))]
|
(when-let [inv (when editable? (node/invert matrix))]
|
||||||
(doall
|
(doall
|
||||||
(for [[i [x y]] (map-indexed vector (pairs pts))]
|
(for [[i [x y]] (map-indexed vector (pairs pts))]
|
||||||
^{:key i}
|
^{:key i}
|
||||||
[:circle {:cx x :cy y :r 2.6 :fill "#fff1be"
|
[:circle.vertex {:cx x :cy y :r 2.6 :fill "#fff1be"
|
||||||
:stroke "#161820" :stroke-width 0.7
|
:stroke "#161820" :stroke-width 0.7
|
||||||
:on-pointer-down
|
:on-pointer-down
|
||||||
(fn [event]
|
(fn [event]
|
||||||
(.stopPropagation event)
|
(.stopPropagation event)
|
||||||
(.preventDefault event)
|
(.preventDefault event)
|
||||||
(.setPointerCapture (.-currentTarget event)
|
(.setPointerCapture (.-currentTarget event)
|
||||||
(.-pointerId event))
|
(.-pointerId event))
|
||||||
(reset! dragging [sid id active i inv]))}])))])]))
|
(reset! dragging [sid id active i inv]))}])))])]))
|
||||||
|
|
||||||
(defn view []
|
(defn view []
|
||||||
;; Reactive on the clip's dimensions, so selecting a clip of another size
|
;; Reactive on the clip's dimensions, so selecting a clip of another size
|
||||||
|
|
@ -174,4 +310,6 @@
|
||||||
:width w :height h
|
:width w :height h
|
||||||
:style {:width (str (* zoom w) "px")
|
:style {:width (str (* zoom w) "px")
|
||||||
:height (str (* zoom h) "px")}}]
|
:height (str (* zoom h) "px")}}]
|
||||||
|
[:canvas.underlay {:ref #(underlay/set-canvas! %)
|
||||||
|
:width (* zoom w) :height (* zoom h)}]
|
||||||
[overlay w h]]]))
|
[overlay w h]]]))
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,6 @@
|
||||||
(ns arthur.ui.timeline
|
(ns arthur.ui.timeline
|
||||||
"The bottom pane: the transport, a ruler, and a row per node of the open symbol.
|
"The bottom pane: the transport, a ruler, and a row per node of the open symbol
|
||||||
|
— the picture's, then, under an `audio` heading, every sound it plays.
|
||||||
|
|
||||||
`rows` is the whole of the interesting part and it is a PURE function of the
|
`rows` is the whole of the interesting part and it is a PURE function of the
|
||||||
clip, the open symbol and the set of open paths. It flattens the document's two
|
clip, the open symbol and the set of open paths. It flattens the document's two
|
||||||
|
|
@ -87,7 +88,10 @@
|
||||||
;; everywhere. `:z` is the lexicographic draw key;
|
;; everywhere. `:z` is the lexicographic draw key;
|
||||||
;; the id breaks ties so the order is stable.
|
;; the id breaks ties so the order is stable.
|
||||||
(sort-by (fn [[id n]] [(or (:z n) "") (str id)]))
|
(sort-by (fn [[id n]] [(or (:z n) "") (str id)]))
|
||||||
reverse)]
|
reverse
|
||||||
|
;; Sounds are listed below the picture, by
|
||||||
|
;; `sound-rows`, wherever they are.
|
||||||
|
(remove #(= :audio (:kind (val %)))))]
|
||||||
(into []
|
(into []
|
||||||
(mapcat
|
(mapcat
|
||||||
(fn [[id n]]
|
(fn [[id n]]
|
||||||
|
|
@ -133,6 +137,50 @@
|
||||||
(walk sid [] 0 identity)
|
(walk sid [] 0 identity)
|
||||||
[])))
|
[])))
|
||||||
|
|
||||||
|
(defn sound-rows
|
||||||
|
"Every sound symbol `sid` plays, one row each, below the picture as an
|
||||||
|
editor's audio tracks are: its own, and those inside what it places at any
|
||||||
|
depth — each TIED to the placement it is heard through, `:via`, and drawn
|
||||||
|
where it is heard, cut to that placement's span as the mix cuts it."
|
||||||
|
[clip sid expanded]
|
||||||
|
(letfn [(walk [sid path ->open [lo hi] via]
|
||||||
|
(mapcat
|
||||||
|
(fn [[id n]]
|
||||||
|
(let [rpath (conj path id)
|
||||||
|
self (comp ->open (local->parent n))
|
||||||
|
[a b] (mapv ->open (or (node/placed-span
|
||||||
|
(cond-> n
|
||||||
|
(and (= :instance (:kind n)) (nil? (:span n)))
|
||||||
|
(assoc :span [0 (get-in clip [:symbols (:of n) :frames])])))
|
||||||
|
[0 (get-in clip [:symbols sid :frames])]))
|
||||||
|
span [(max lo a) (min hi b)]
|
||||||
|
open? (contains? expanded rpath)]
|
||||||
|
(case (:kind n)
|
||||||
|
:audio (cons {:path rpath
|
||||||
|
:depth 0
|
||||||
|
:label (node-label id n)
|
||||||
|
:kind :node
|
||||||
|
:node-kind :audio
|
||||||
|
:via via
|
||||||
|
;; A sound heard through a placement is
|
||||||
|
;; that placement's picture's sound: its bar
|
||||||
|
;; moves the placement, so the two stay in
|
||||||
|
;; sync. Moving the placement moves it too.
|
||||||
|
:slides (if via (subvec rpath 0 1) rpath)
|
||||||
|
:select [:node sid id rpath]
|
||||||
|
:expandable? true
|
||||||
|
:expanded? open?
|
||||||
|
:span span
|
||||||
|
:keys (into [] (comp (mapcat keyed-frames) (map self) (distinct))
|
||||||
|
(vals (node/channels n)))}
|
||||||
|
(when open? (channel-rows n rpath 1 self span)))
|
||||||
|
:instance (walk (:of n) rpath self span (or via (node-label id n)))
|
||||||
|
nil)))
|
||||||
|
(sort-by (fn [[id n]] [(or (:z n) "") (str id)]) (get-in clip [:symbols sid :nodes]))))]
|
||||||
|
(if (get-in clip [:symbols sid])
|
||||||
|
(vec (walk sid [] identity [##-Inf ##Inf] nil))
|
||||||
|
[])))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; geometry
|
;; geometry
|
||||||
;;
|
;;
|
||||||
|
|
@ -189,21 +237,35 @@
|
||||||
(when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))]]))
|
(when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))]]))
|
||||||
|
|
||||||
(defn- takes?
|
(defn- takes?
|
||||||
"Whether the row at `target` can take the row being carried: not itself, and
|
"Whether the row at `target`, a `target-kind` node, can take the row being
|
||||||
not anything inside it."
|
carried: not itself, and not anything inside it. A sound goes into a
|
||||||
[target]
|
placement or beside another sound, and only a sound goes beside a sound."
|
||||||
|
[target target-kind]
|
||||||
(when-let [from (drag/row)]
|
(when-let [from (drag/row)]
|
||||||
(not= from (subvec target 0 (min (count from) (count target))))))
|
(and (not= from (subvec target 0 (min (count from) (count target))))
|
||||||
|
(if (= :audio (drag/row-kind))
|
||||||
|
(#{:audio :instance} target-kind)
|
||||||
|
(not= :audio target-kind)))))
|
||||||
|
|
||||||
(defn- zone
|
(defn- zone
|
||||||
"Which part of a row the pointer is over: its top edge, to go in front of it;
|
"Which part of a row the pointer is over: its top edge, to go in front of it;
|
||||||
its bottom edge, to go behind; its middle, to go into it or be grouped with it."
|
its bottom edge, to go behind; its middle, to go into it or be grouped with it.
|
||||||
[^js e]
|
Nothing goes into a sound, so its middle is behind it."
|
||||||
|
[^js e node-kind]
|
||||||
(let [box (.getBoundingClientRect (.-currentTarget e))
|
(let [box (.getBoundingClientRect (.-currentTarget e))
|
||||||
y (/ (- (.-clientY e) (.-top box)) (max 1 (.-height box)))]
|
y (/ (- (.-clientY e) (.-top box)) (max 1 (.-height box)))]
|
||||||
(cond (< y 0.3) :front (> y 0.7) :back :else :into)))
|
(cond (< y 0.3) :front
|
||||||
|
(or (> y 0.7) (= :audio node-kind)) :back
|
||||||
|
:else :into)))
|
||||||
|
|
||||||
(defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of]}
|
(def ^:private reveal
|
||||||
|
"A ref that scrolls the selected row into view, ONE per selection: React calls
|
||||||
|
a ref again only when it is a different function, so a row is scrolled to when
|
||||||
|
it becomes the selected one — from the stage, maybe, five rows down — and not
|
||||||
|
on every render after, which would fight a person scrolling away."
|
||||||
|
(memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"}))))))
|
||||||
|
|
||||||
|
(defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of via]}
|
||||||
selection over solo]
|
selection over solo]
|
||||||
(let [node? (= :node kind)
|
(let [node? (= :node kind)
|
||||||
[over-path where] @over]
|
[over-path where] @over]
|
||||||
|
|
@ -216,6 +278,7 @@
|
||||||
(if (= :instance node-kind) " drop-into" " drop-group"))))
|
(if (= :instance node-kind) " drop-into" " drop-group"))))
|
||||||
:style {:padding-left (str (+ 4 (* 11 depth)) "px")}
|
:style {:padding-left (str (+ 4 (* 11 depth)) "px")}
|
||||||
:title label
|
:title label
|
||||||
|
:ref (when (and select (= select selection)) (reveal selection))
|
||||||
:on-click #(when select (rf/dispatch [::ui/select select]))
|
:on-click #(when select (rf/dispatch [::ui/select select]))
|
||||||
;; An instance's row opens the symbol it places, as a tab.
|
;; An instance's row opens the symbol it places, as a tab.
|
||||||
:on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))}
|
:on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))}
|
||||||
|
|
@ -229,21 +292,21 @@
|
||||||
(.stopPropagation e)
|
(.stopPropagation e)
|
||||||
(.setData (.-dataTransfer e) "text/plain" "row")
|
(.setData (.-dataTransfer e) "text/plain" "row")
|
||||||
(set! (.. e -dataTransfer -effectAllowed) "move")
|
(set! (.. e -dataTransfer -effectAllowed) "move")
|
||||||
(drag/row! path))
|
(drag/row! path node-kind))
|
||||||
:on-drag-end (fn [_] (reset! over nil) (drag/done!))
|
:on-drag-end (fn [_] (reset! over nil) (drag/done!))
|
||||||
:on-drag-enter (fn [^js e] (when (takes? path) (.preventDefault e)))
|
:on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e)))
|
||||||
:on-drag-over (fn [^js e]
|
:on-drag-over (fn [^js e]
|
||||||
(when (takes? path)
|
(when (takes? path node-kind)
|
||||||
(.preventDefault e)
|
(.preventDefault e)
|
||||||
(.stopPropagation e)
|
(.stopPropagation e)
|
||||||
(set! (.. e -dataTransfer -dropEffect) "move")
|
(set! (.. e -dataTransfer -dropEffect) "move")
|
||||||
(let [o [path (zone e)]]
|
(let [o [path (zone e node-kind)]]
|
||||||
(when (not= o @over) (reset! over o)))))
|
(when (not= o @over) (reset! over o)))))
|
||||||
:on-drop (fn [^js e]
|
:on-drop (fn [^js e]
|
||||||
(.preventDefault e)
|
(.preventDefault e)
|
||||||
(.stopPropagation e)
|
(.stopPropagation e)
|
||||||
(let [from (when (takes? path) (drag/row))
|
(let [from (when (takes? path node-kind) (drag/row))
|
||||||
where (zone e)]
|
where (zone e node-kind)]
|
||||||
(reset! over nil)
|
(reset! over nil)
|
||||||
(drag/done!)
|
(drag/done!)
|
||||||
(when from
|
(when from
|
||||||
|
|
@ -259,7 +322,7 @@
|
||||||
(rf/dispatch [::ui/toggle-row path]))}
|
(rf/dispatch [::ui/toggle-row path]))}
|
||||||
(when expandable? (if expanded? "▾" "▸"))]
|
(when expandable? (if expanded? "▾" "▸"))]
|
||||||
[:span.name label]
|
[:span.name label]
|
||||||
(when node? [:span.kind (str "·" (name node-kind))])
|
(when node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))])
|
||||||
(when (= :instance node-kind)
|
(when (= :instance node-kind)
|
||||||
[:button {:class (str "tl-solo" (when (contains? solo path) " on"))
|
[:button {:class (str "tl-solo" (when (contains? solo path) " on"))
|
||||||
:title "show only this on the stage (⇧ for more than one)"
|
:title "show only this on the stage (⇧ for more than one)"
|
||||||
|
|
@ -278,19 +341,19 @@
|
||||||
"`sliding` is the pointer's side of a bar being dragged, `{:path :x :width
|
"`sliding` is the pointer's side of a bar being dragged, `{:path :x :width
|
||||||
:df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every
|
:df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every
|
||||||
row and the stage are drawn from already has in it."
|
row and the stage are drawn from already has in it."
|
||||||
[{:keys [path span keys dense? kind select]} frames sliding]
|
[{:keys [path span keys dense? kind node-kind select slides]} frames sliding]
|
||||||
(let [{from :path x0 :x width :width} @sliding
|
(let [{from :path x0 :x width :width} @sliding
|
||||||
slide (fn [^js e]
|
slide (fn [^js e]
|
||||||
(when (= path from)
|
(when (= path from)
|
||||||
(let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))]
|
(let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))]
|
||||||
(when (not= df (:df @sliding))
|
(when (not= df (:df @sliding))
|
||||||
(swap! sliding assoc :df df)
|
(swap! sliding assoc :df df)
|
||||||
(rf/dispatch [::ui/sliding path df])))))
|
(rf/dispatch [::ui/sliding (or slides path) df])))))
|
||||||
done (fn [commit?]
|
done (fn [commit?]
|
||||||
(when (= path from)
|
(when (= path from)
|
||||||
(let [df (:df @sliding)]
|
(let [df (:df @sliding)]
|
||||||
(reset! sliding nil)
|
(reset! sliding nil)
|
||||||
(rf/dispatch (if commit? [::ui/slide path df] [::ui/sliding nil])))))]
|
(rf/dispatch (if commit? [::ui/slide (or slides path) df] [::ui/sliding nil])))))]
|
||||||
[:div.tl-track
|
[:div.tl-track
|
||||||
;; The track, not the bar, holds the pointer while a bar slides, so the drag
|
;; The track, not the bar, holds the pointer while a bar slides, so the drag
|
||||||
;; goes on when the bar has slid off the ruler and is no longer drawn.
|
;; goes on when the bar has slid off the ruler and is no longer drawn.
|
||||||
|
|
@ -302,6 +365,7 @@
|
||||||
(when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])]
|
(when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])]
|
||||||
(when (< in out)
|
(when (< in out)
|
||||||
[:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
|
[:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
|
||||||
|
(when (= :audio node-kind) " sound")
|
||||||
(when select " movable") (when (= path from) " sliding"))
|
(when select " movable") (when (= path from) " sliding"))
|
||||||
:style {:left (edge% in frames)
|
:style {:left (edge% in frames)
|
||||||
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
|
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
|
||||||
|
|
@ -337,14 +401,24 @@
|
||||||
expanded @(rf/subscribe [::sub/expanded])
|
expanded @(rf/subscribe [::sub/expanded])
|
||||||
drop @(rf/subscribe [::sub/drop])
|
drop @(rf/subscribe [::sub/drop])
|
||||||
solo (set @(rf/subscribe [::render/solo]))
|
solo (set @(rf/subscribe [::render/solo]))
|
||||||
|
open @(rf/subscribe [::render/open])
|
||||||
;; Where a drag out of the pool would land, as a row of its own at the
|
;; Where a drag out of the pool would land, as a row of its own at the
|
||||||
;; top: its own length, starting on the frame it would start on. The
|
;; top of its section: its own length, starting on the frame it would
|
||||||
;; stage's drop shows it too, at the playhead.
|
;; start on. The stage's drop shows it too, at the playhead.
|
||||||
visible (cond->> (rows clip @(rf/subscribe [::render/open]) expanded)
|
ghost (when drop
|
||||||
drop (cons {:path [::drop] :depth 0 :kind :ghost
|
{:path [::drop] :depth 0 :kind :ghost
|
||||||
:label (str "+ " (:label drop))
|
:label (str "+ " (:label drop))
|
||||||
:span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]
|
:span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]
|
||||||
:keys []}))
|
:keys []})
|
||||||
|
picture (cond->> (rows clip open expanded)
|
||||||
|
(and ghost (not (:sound? drop))) (cons ghost))
|
||||||
|
sounds (cond->> (sound-rows clip open expanded)
|
||||||
|
(and ghost (:sound? drop)) (cons ghost))
|
||||||
|
;; The audio section's heading is a row like the others, so the two
|
||||||
|
;; columns stay aligned without measuring anything.
|
||||||
|
visible (cond-> (vec picture)
|
||||||
|
(seq sounds) (-> (conj {:path [::sounds] :kind :section :label "audio"})
|
||||||
|
(into sounds)))
|
||||||
;; Roughly ten labels, on a round number of frames.
|
;; Roughly ten labels, on a round number of frames.
|
||||||
step (* 10 (js/Math.ceil (/ frames 100)))]
|
step (* 10 (js/Math.ceil (/ frames 100)))]
|
||||||
[:section.pane.time
|
[:section.pane.time
|
||||||
|
|
@ -365,7 +439,10 @@
|
||||||
(rf/dispatch [::ui/move-node from []]))))}
|
(rf/dispatch [::ui/move-node from []]))))}
|
||||||
[:div.tl-corner]
|
[:div.tl-corner]
|
||||||
(doall (for [row visible]
|
(doall (for [row visible]
|
||||||
^{:key (str (:path row))} [label-cell row selection over solo]))]
|
(with-meta (if (= :section (:kind row))
|
||||||
|
[:div.tl-label.tl-section (:label row)]
|
||||||
|
[label-cell row selection over solo])
|
||||||
|
{:key (str (:path row))})))]
|
||||||
[:div.tl-tracks
|
[:div.tl-tracks
|
||||||
{:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
|
{:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
|
||||||
:on-drag-over (fn [^js e]
|
:on-drag-over (fn [^js e]
|
||||||
|
|
@ -411,6 +488,9 @@
|
||||||
[:div.tl-knob {:style {:left (at% frame frames)}}]]
|
[:div.tl-knob {:style {:left (at% frame frames)}}]]
|
||||||
(if (seq visible)
|
(if (seq visible)
|
||||||
(doall (for [row visible]
|
(doall (for [row visible]
|
||||||
^{:key (str (:path row))} [track-cell row frames sliding]))
|
(with-meta (if (= :section (:kind row))
|
||||||
|
[:div.tl-track.tl-section]
|
||||||
|
[track-cell row frames sliding])
|
||||||
|
{:key (str (:path row))})))
|
||||||
[:div.tl-empty "nothing in this symbol"])
|
[:div.tl-empty "nothing in this symbol"])
|
||||||
[:div.tl-playhead {:style {:left (at% frame frames)}}]]]])))
|
[:div.tl-playhead {:style {:left (at% frame frames)}}]]]])))
|
||||||
|
|
|
||||||
81
frontend/src/arthur/ui/underlay.cljs
Normal file
81
frontend/src/arthur/ui/underlay.cljs
Normal file
|
|
@ -0,0 +1,81 @@
|
||||||
|
(ns arthur.ui.underlay
|
||||||
|
"The footage a face is traced over, on its own canvas above the stage.
|
||||||
|
|
||||||
|
A REFERENCE, NOT OUTPUT. The tracing still never enters the indexed raster, so
|
||||||
|
it cannot reach an export, and it is drawn OVER the picture at the instance's
|
||||||
|
opacity rather than under it, because the raster clears to an opaque ground.
|
||||||
|
The canvas is the stage's size on screen, not the raster's, so a 1280px still
|
||||||
|
is not squeezed through a 320px stage on its way to being seen.
|
||||||
|
|
||||||
|
Painted by `ui/player` straight after each frame, from the same snapshot, so
|
||||||
|
it moves with the face it registers to — see `domain/trace/photo-matrix`."
|
||||||
|
(:require [arthur.domain.symbol :as symbol]
|
||||||
|
[arthur.domain.trace :as trace]
|
||||||
|
[arthur.flow.ingest :as ingest]))
|
||||||
|
|
||||||
|
(defonce ^:private state (atom {:canvas nil :urls {} :images {}}))
|
||||||
|
|
||||||
|
(defn set-canvas! [el] (swap! state assoc :canvas el))
|
||||||
|
|
||||||
|
(defn- urls
|
||||||
|
"The footage's still URLs, or nil until its manifest has come back."
|
||||||
|
[footage-id on-ready]
|
||||||
|
(let [u (get-in @state [:urls footage-id])]
|
||||||
|
(when (nil? u)
|
||||||
|
(swap! state assoc-in [:urls footage-id] :loading)
|
||||||
|
(-> (ingest/manifest! footage-id)
|
||||||
|
(.then (fn [m]
|
||||||
|
(swap! state assoc-in [:urls footage-id] (:urls m))
|
||||||
|
(on-ready)))
|
||||||
|
(.catch (fn [error]
|
||||||
|
(swap! state assoc-in [:urls footage-id] :failed)
|
||||||
|
(js/console.error "arthur: no stills for footage" footage-id error)))))
|
||||||
|
(when (vector? u) u)))
|
||||||
|
|
||||||
|
(def ^:private ^:const kept
|
||||||
|
"Decoded stills held at once. A 1280px still is about 5MB decoded, and
|
||||||
|
scrubbing a face with no trace keys asks for every frame of the take."
|
||||||
|
48)
|
||||||
|
|
||||||
|
(defn- image
|
||||||
|
"The still at `url`, or nil until it has loaded."
|
||||||
|
[url on-ready]
|
||||||
|
(let [img (or (get-in @state [:images url])
|
||||||
|
(let [img (js/Image.)]
|
||||||
|
(set! (.-onload img) on-ready)
|
||||||
|
(set! (.-src img) url)
|
||||||
|
(swap! state update :images
|
||||||
|
#(assoc (if (< (count %) kept) % {}) url img))
|
||||||
|
img))]
|
||||||
|
(when (and (.-complete img) (pos? (.-naturalHeight img))) img)))
|
||||||
|
|
||||||
|
(defn paint!
|
||||||
|
"Draw every switched-on underlay on the frame `resolver` last resolved. It
|
||||||
|
says where each face's head went and which of its frames it was on, so this
|
||||||
|
reads the frame rather than resolving it again. `on-ready` is called when a
|
||||||
|
still or a manifest that was missing arrives, to paint again."
|
||||||
|
[{:keys [document store footage-id traces width]} resolver on-ready]
|
||||||
|
(when-let [^js canvas (:canvas @state)]
|
||||||
|
(let [ctx (.getContext canvas "2d")
|
||||||
|
zoom (/ (.-width canvas) width)]
|
||||||
|
(.setTransform ctx 1 0 0 1 0 0)
|
||||||
|
(.clearRect ctx 0 0 (.-width canvas) (.-height canvas))
|
||||||
|
(when-let [us (and (seq traces) footage-id (urls footage-id on-ready))]
|
||||||
|
(let [start (first (get-in document [:analysis :range] [0]))]
|
||||||
|
(doseq [{:keys [path face opacity]} traces
|
||||||
|
:let [at (conj path :head)
|
||||||
|
world (symbol/world-of resolver at)
|
||||||
|
frame (symbol/frame-of resolver at)]
|
||||||
|
:when (and world (number? frame))
|
||||||
|
:let [head (get-in document [:symbols face :nodes :head])
|
||||||
|
p (trace/photo-frame (trace/of head) (js/Math.floor frame))
|
||||||
|
img (some-> (get us (+ start p)) (image on-ready))
|
||||||
|
m (when img
|
||||||
|
(trace/photo-matrix world head store p (.-naturalHeight img)))]
|
||||||
|
:when m]
|
||||||
|
(set! (.-globalAlpha ctx) opacity)
|
||||||
|
(.setTransform ctx
|
||||||
|
(* zoom (aget m 0)) (* zoom (aget m 1))
|
||||||
|
(* zoom (aget m 2)) (* zoom (aget m 3))
|
||||||
|
(* zoom (aget m 4)) (* zoom (aget m 5)))
|
||||||
|
(.drawImage ctx img 0 0)))))))
|
||||||
122
frontend/test/arthur/domain/gesture_test.cljs
Normal file
122
frontend/test/arthur/domain/gesture_test.cljs
Normal file
|
|
@ -0,0 +1,122 @@
|
||||||
|
(ns arthur.domain.gesture-test
|
||||||
|
(:require [cljs.test :refer [deftest is testing]]
|
||||||
|
[arthur.domain.channel :as ch]
|
||||||
|
[arthur.domain.clip :as clip]
|
||||||
|
[arthur.domain.gesture :as gesture]
|
||||||
|
[arthur.domain.nest :as nest]
|
||||||
|
[arthur.domain.node :as node]
|
||||||
|
[arthur.domain.paint :as paint]
|
||||||
|
[arthur.domain.palette :as pal]
|
||||||
|
[arthur.domain.pick :as pick]))
|
||||||
|
|
||||||
|
(def ^:private u #uuid "00000000-0000-4000-8000-0000000000e1")
|
||||||
|
(def ^:private v #uuid "00000000-0000-4000-8000-0000000000e2")
|
||||||
|
|
||||||
|
(defn- two-down
|
||||||
|
"A shape inside :box, placed turned and scaled unevenly in :mid, placed turned
|
||||||
|
and doubled in :main — so nothing lines up by accident."
|
||||||
|
[]
|
||||||
|
(let [turn (fn [c host id pos rot k]
|
||||||
|
(update-in c [:symbols host :nodes id :channels] merge
|
||||||
|
{[:xform :pos] (ch/framed pos)
|
||||||
|
[:xform :rot] (ch/framed rot)
|
||||||
|
[:xform :scale] (ch/framed k)}))]
|
||||||
|
(-> (clip/blank)
|
||||||
|
(assoc-in [:symbols :mid] {:id :mid :frames 40 :nodes {}})
|
||||||
|
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
|
||||||
|
(clip/place-symbol nil :main :mid 10 u nil)
|
||||||
|
(clip/place-symbol nil :mid :box 2 v nil)
|
||||||
|
(turn :main u [40 20] (/ js/Math.PI 2) [2 2])
|
||||||
|
(turn :mid v [5 -3] 0.3 [1.5 0.5])
|
||||||
|
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow)
|
||||||
|
(assoc-in [:symbols :box :nodes :shape :channels [:xform :anchor]] (ch/framed [5 3])))))
|
||||||
|
|
||||||
|
(defn- drawn [c path]
|
||||||
|
(partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %))
|
||||||
|
((clip/resolver c nil pal/index-of :main) 16))))))))
|
||||||
|
|
||||||
|
(defn- near? [a b] (every? #(< (js/Math.abs %) 1e-9) (map - (flatten a) (flatten b))))
|
||||||
|
|
||||||
|
(defn- dragged [c path f vs-fn]
|
||||||
|
(let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
|
||||||
|
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame)]
|
||||||
|
(gesture/apply-values c sid id frame (vs-fn pl v0))))
|
||||||
|
|
||||||
|
(deftest a-shape-two-symbols-down-moves-under-the-pointer
|
||||||
|
(doseq [path [[u] [u v] [u v :shape]]]
|
||||||
|
(let [c (two-down)
|
||||||
|
moved (dragged c path 16 #(gesture/move %1 %2 [30 30] [37 26]))]
|
||||||
|
(is (near? (map (fn [[x y]] [(+ x 7) (- y 4)]) (drawn c [u v :shape]))
|
||||||
|
(drawn moved [u v :shape]))
|
||||||
|
(str "moving " path " by (7, -4) on the stage moves the shape by (7, -4)")))))
|
||||||
|
|
||||||
|
(deftest turning-keeps-the-pivot-where-it-is
|
||||||
|
(let [c (two-down)
|
||||||
|
path [u v :shape]
|
||||||
|
{:keys [world]} (nest/placement c nil :main path 16)
|
||||||
|
pivot #(let [out (js/Float64Array. 2)]
|
||||||
|
(vec (array-seq (node/apply-pt! out 0 (:world (nest/placement % nil :main path 16)) 5 3))))
|
||||||
|
turned (dragged c path 16 #(gesture/turn %2 0.7))]
|
||||||
|
(is (some? world))
|
||||||
|
(is (near? (pivot c) (pivot turned)) "the anchor stays put")
|
||||||
|
(is (not (near? (drawn c path) (drawn turned path))) "and the rest goes round it")))
|
||||||
|
|
||||||
|
(deftest scaling-takes-the-grabbed-point-to-the-pointer
|
||||||
|
(let [c (two-down)
|
||||||
|
path [u v :shape]
|
||||||
|
{:keys [world]} (nest/placement c nil :main path 16)
|
||||||
|
out (js/Float64Array. 2)
|
||||||
|
at #(vec (array-seq (node/apply-pt! out 0 %1 %2 %3)))
|
||||||
|
p0 (at world 10 0)
|
||||||
|
p1 [(+ (first p0) 3) (- (second p0) 5)]
|
||||||
|
grown (dragged c path 16 #(gesture/scale %1 %2 p0 p1 false))
|
||||||
|
w2 (:world (nest/placement grown nil :main path 16))]
|
||||||
|
(is (near? p1 (at w2 10 0))
|
||||||
|
"the corner grabbed is under the pointer, through a turned, unevenly scaled parent")
|
||||||
|
(is (near? (at world 5 3) (at w2 5 3)) "about the pivot")))
|
||||||
|
|
||||||
|
(deftest a-drag-keys-a-keyed-channel-and-sets-a-framed-one
|
||||||
|
(let [c (update-in (two-down) [:symbols :mid :nodes v :channels [:xform :pos]]
|
||||||
|
(constantly (ch/keyed {0 [5 -3] 20 [9 -3]} :linear)))
|
||||||
|
moved (dragged c [u v] 16 #(gesture/move %1 %2 [0 0] [4 0]))
|
||||||
|
pos (get-in moved [:symbols :mid :nodes v :channels [:xform :pos]])
|
||||||
|
rot (dragged c [u v] 16 #(gesture/turn %2 0.1))]
|
||||||
|
(is (= #{0 4 20} (set (keys (:keys pos))))
|
||||||
|
"a key on the instance's own frame — 16 of main is 6 of mid, 4 of its own — and the others kept")
|
||||||
|
(is (= {:animated? false :value 0.4}
|
||||||
|
(update (get-in rot [:symbols :mid :nodes v :channels [:xform :rot]]) :value
|
||||||
|
#(/ (js/Math.round (* 10 %)) 10)))
|
||||||
|
"a channel with no keys has its one value changed")))
|
||||||
|
|
||||||
|
(deftest a-measured-transform-is-not-set-by-hand
|
||||||
|
(is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}})))
|
||||||
|
(is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]})}}))))
|
||||||
|
|
||||||
|
(deftest a-click-selects-the-level-figma-would
|
||||||
|
(let [hit [:a :b :c :shape]]
|
||||||
|
(testing "choose"
|
||||||
|
(is (= [:a] (pick/choose nil hit false)) "the thing in the open symbol")
|
||||||
|
(is (= hit (pick/choose nil hit true)) "⌘ goes to the shape")
|
||||||
|
(is (= [:a :b] (pick/choose [:a :b] hit false)) "inside what is selected keeps it")
|
||||||
|
(is (= [:a :x] (pick/choose [:a :b] [:a :x :y] false)) "beside it, at the same depth")
|
||||||
|
(is (= [:z] (pick/choose [:a :b] [:z :y] false)) "elsewhere, from the top")
|
||||||
|
(is (nil? (pick/choose [:a] nil false)) "nothing, on nothing"))
|
||||||
|
(testing "deeper"
|
||||||
|
(is (= [:a :b] (pick/deeper [:a] hit)))
|
||||||
|
(is (= hit (pick/deeper hit hit)) "not past the shape")
|
||||||
|
(is (= [:z] (pick/deeper [:z] hit)) "and not into something else"))))
|
||||||
|
|
||||||
|
(deftest the-topmost-op-under-the-point-is-hit
|
||||||
|
(let [sq (fn [node x0] {:kind :poly :node node :n 4
|
||||||
|
:pts (js/Float64Array. #js [x0 0 (+ x0 10) 0 (+ x0 10) 10 x0 10])})
|
||||||
|
ops [(sq :under 0) (sq [u :over] 5) {:kind :disc :node :dot :cx 50 :cy 50 :r 1}]]
|
||||||
|
(is (= [u :over] (pick/hit ops [7 5])) "the later op is drawn on top")
|
||||||
|
(is (= [:under] (pick/hit ops [2 5])))
|
||||||
|
(is (= [:dot] (pick/hit ops [52.5 50])) "a few-pixel shape can be missed by a little")
|
||||||
|
(is (nil? (pick/hit ops [30 30])))))
|
||||||
|
|
||||||
|
(deftest an-instances-box-is-what-its-symbol-draws
|
||||||
|
(let [c (two-down)
|
||||||
|
{:keys [frame]} (nest/placement c nil :main [u v] 16)]
|
||||||
|
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :mid :nodes v]) frame)))
|
||||||
|
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :box :nodes :shape]) 4)))))
|
||||||
|
|
@ -69,7 +69,7 @@
|
||||||
out (js/Float64Array. 2)
|
out (js/Float64Array. 2)
|
||||||
seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y))))
|
seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y))))
|
||||||
(partition 2 [0 0 10 0 5 10]))
|
(partition 2 [0 0 10 0 5 10]))
|
||||||
[x y] (array-seq (node/apply-pt! out 0 (nest/invert matrix) 7 3))
|
[x y] (array-seq (node/apply-pt! out 0 (node/invert matrix) 7 3))
|
||||||
moved (paint/set-vertex c :box :shape frame 0 [x y])
|
moved (paint/set-vertex c :box :shape frame 0 [x y])
|
||||||
keyed (paint/add-key c :box :shape (:frame (nest/inside c nil :main [u v :shape] 20)))]
|
keyed (paint/add-key c :box :shape (:frame (nest/inside c nil :main [u v :shape] 20)))]
|
||||||
(is (= 4 frame) "16 of main is 6 of mid, which is 4 of box and of the shape in it")
|
(is (= 4 frame) "16 of main is 6 of mid, which is 4 of box and of the shape in it")
|
||||||
|
|
@ -238,3 +238,26 @@
|
||||||
"and nothing else is renumbered")
|
"and nothing else is renumbered")
|
||||||
(is (:refused (nest/restack c :main [:a] [a-uuid :inner] true))
|
(is (:refused (nest/restack c :main [:a] [a-uuid :inner] true))
|
||||||
"only among the things it is beside")))
|
"only among the things it is beside")))
|
||||||
|
|
||||||
|
(deftest a-sound-dropped-in-a-placed-symbol-is-heard-where-the-placement-puts-it
|
||||||
|
(let [u #uuid "00000000-0000-4000-8000-0000000000a1"
|
||||||
|
c (-> (nested)
|
||||||
|
(clip/place-sound :inner {:sound "tone"} "tone.mp3" 40 1 2 u))
|
||||||
|
sound (get-in c [:symbols :inner :nodes u])
|
||||||
|
[heard] (nest/audio-tracks c :outer)]
|
||||||
|
(is (empty? (node/problems sound)) "a sound needs no transform")
|
||||||
|
(is (= {:sound "tone"} (:source sound)))
|
||||||
|
(is (= #{[:audio :gain] [:audio :pan] [:audio :rate]} (set (keys (node/channels sound)))))
|
||||||
|
(is (= [0 8] (:span heard))
|
||||||
|
"own frames 0-8: it starts on inner's 2 and inner ends on 10")
|
||||||
|
(is (= [7 15] (node/placed-span heard)) "inner starts on 5 of outer")
|
||||||
|
(is (empty? ((clip/resolver c nil pal/index-of :inner) 3))
|
||||||
|
"and it draws nothing")
|
||||||
|
(is (= c (clip/place-sound c :inner {:sound "tone"} "tone.mp3" 40 1 10 (random-uuid)))
|
||||||
|
"nor lands past the end of its symbol")
|
||||||
|
(testing "a video's own sound keeps its length at another rate"
|
||||||
|
(let [v (-> (nested)
|
||||||
|
(clip/place-sound :outer {:footage "f"} "take" 90 2.5 0 u)
|
||||||
|
(get-in [:symbols :outer :nodes u]))]
|
||||||
|
(is (empty? (node/problems v)))
|
||||||
|
(is (= [0 36] (node/placed-span v)) "90 frames at 30 are 36 at 12")))))
|
||||||
|
|
|
||||||
|
|
@ -157,8 +157,8 @@
|
||||||
(deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them
|
(deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them
|
||||||
;; A decomposition is not extensible after the fact: adding a component later
|
;; A decomposition is not extensible after the fact: adding a component later
|
||||||
;; means migrating every stored transform. So both are present from the start,
|
;; means migrating every stored transform. So both are present from the start,
|
||||||
;; on every kind.
|
;; on every kind that is in the picture.
|
||||||
(doseq [k node/implemented-kinds]
|
(doseq [k (disj node/implemented-kinds :audio)]
|
||||||
(is (contains? (get node/valid-paths k) [:xform :skew]) (str k))
|
(is (contains? (get node/valid-paths k) [:xform :skew]) (str k))
|
||||||
(is (contains? (get node/valid-paths k) [:xform :anchor]) (str k))))
|
(is (contains? (get node/valid-paths k) [:xform :anchor]) (str k))))
|
||||||
|
|
||||||
|
|
@ -168,7 +168,13 @@
|
||||||
(is (contains? (:disc node/valid-paths) [:geom :radius]))
|
(is (contains? (:disc node/valid-paths) [:geom :radius]))
|
||||||
(is (contains? (:rect node/valid-paths) [:geom :size]))
|
(is (contains? (:rect node/valid-paths) [:geom :size]))
|
||||||
(is (not (contains? (:group node/valid-paths) [:geom :pts]))
|
(is (not (contains? (:group node/valid-paths) [:geom :pts]))
|
||||||
"a group is a pure transform node"))
|
"a group is a pure transform node")
|
||||||
|
(is (= #{[:audio :gain] [:audio :pan] [:audio :rate]} (:audio node/valid-paths))
|
||||||
|
"a sound has no transform"))
|
||||||
|
|
||||||
|
(deftest a-sound-defaults-to-its-own-channels
|
||||||
|
(is (= (set (keys node/audio-defaults))
|
||||||
|
(set (keys (node/channels {:id :s :kind :audio}))))))
|
||||||
|
|
||||||
(deftest problems-names-the-ways-a-node-is-malformed
|
(deftest problems-names-the-ways-a-node-is-malformed
|
||||||
(is (empty? (node/problems {:id :x :kind :group :z "a1"})))
|
(is (empty? (node/problems {:id :x :kind :group :z "a1"})))
|
||||||
|
|
@ -200,4 +206,13 @@
|
||||||
(let [d (node/toggle-key b [:xform :rot] 3)]
|
(let [d (node/toggle-key b [:xform :rot] 3)]
|
||||||
(is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again")
|
(is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again")
|
||||||
(is (= 1.0 (rot d 0))))
|
(is (= 1.0 (rot d 0))))
|
||||||
(is (= :hold (get-in (node/toggle-key n [:vis] 0) [:channels [:vis] :interp])) "a boolean holds")))
|
(is (= :hold (get-in (node/toggle-key n [:vis] 0) [:channels [:vis] :interp])) "a boolean holds")
|
||||||
|
(let [h (node/set-segment-interp c [:xform :pos] 0 :hold)]
|
||||||
|
(is (= [5 5] (pos h 5)) "a gap set to hold cuts at the next key")
|
||||||
|
(is (= [10 0] (pos h 10)))
|
||||||
|
(is (= [7.5 2.5] (pos (node/set-segment-interp h [:xform :pos] 0 :linear) 5)) "and back to a tween")
|
||||||
|
(is (= h (node/set-segment-interp h [:xform :pos] 10 :hold)) "the last key has no gap after it")
|
||||||
|
(is (empty? (ch/problems (get-in h [:channels [:xform :pos]])))))
|
||||||
|
(let [d (node/toggle-key (node/set-segment-interp c [:xform :pos] 0 :hold) [:xform :pos] 0)]
|
||||||
|
(is (not (contains? (get-in d [:channels [:xform :pos] :segments]) 0))
|
||||||
|
"taking a key off takes its gap's choice with it"))))
|
||||||
|
|
|
||||||
|
|
@ -3,6 +3,7 @@
|
||||||
[arthur.demo :as demo]
|
[arthur.demo :as demo]
|
||||||
[arthur.domain.channel :as channel]
|
[arthur.domain.channel :as channel]
|
||||||
[arthur.domain.leaf :as leaf]
|
[arthur.domain.leaf :as leaf]
|
||||||
|
[arthur.domain.node :as node]
|
||||||
[arthur.domain.paint :as paint]
|
[arthur.domain.paint :as paint]
|
||||||
[arthur.domain.symbol :as symbol]))
|
[arthur.domain.symbol :as symbol]))
|
||||||
|
|
||||||
|
|
@ -17,7 +18,8 @@
|
||||||
c3 (paint/add-key c2 :main :paint-test 15)
|
c3 (paint/add-key c2 :main :paint-test 15)
|
||||||
c4 (paint/set-vertex c3 :main :paint-test 15 0 [34 10])
|
c4 (paint/set-vertex c3 :main :paint-test 15 0 [34 10])
|
||||||
held (geometry c4)
|
held (geometry c4)
|
||||||
mixed-clip (paint/set-segment-interp c4 :main :paint-test 9 :linear)
|
mixed-clip (update-in c4 [:symbols :main :nodes :paint-test]
|
||||||
|
node/set-segment-interp paint/geometry 9 :linear)
|
||||||
mixed (geometry mixed-clip)]
|
mixed (geometry mixed-clip)]
|
||||||
(is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span])))
|
(is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span])))
|
||||||
(is (= a (channel/value-at held 8)))
|
(is (= a (channel/value-at held 8)))
|
||||||
|
|
|
||||||
114
frontend/test/arthur/domain/trace_test.cljs
Normal file
114
frontend/test/arthur/domain/trace_test.cljs
Normal file
|
|
@ -0,0 +1,114 @@
|
||||||
|
(ns arthur.domain.trace-test
|
||||||
|
(:require [cljs.test :refer [deftest is]]
|
||||||
|
[arthur.demo.take :as take]
|
||||||
|
[arthur.domain.clip :as clip]
|
||||||
|
[arthur.domain.leaf :as leaf]
|
||||||
|
[arthur.domain.nest :as nest]
|
||||||
|
[arthur.domain.palette :as pal]
|
||||||
|
[arthur.domain.symbol :as symbol]
|
||||||
|
[arthur.domain.trace :as trace]
|
||||||
|
[arthur.flow.freeze :as freeze]))
|
||||||
|
|
||||||
|
(def ^:private frozen (delay (freeze/head-mode {} @take/frozen)))
|
||||||
|
(def ^:private store (delay (:store @take/frozen)))
|
||||||
|
|
||||||
|
(defn- traced
|
||||||
|
"The synthetic take with face-1's trace set to `t`."
|
||||||
|
[t]
|
||||||
|
(assoc-in @frozen [:symbols :face-1 :nodes :head :trace] t))
|
||||||
|
|
||||||
|
(defn- head [c] (get-in c [:symbols :face-1 :nodes :head]))
|
||||||
|
|
||||||
|
(defn- near? [a b]
|
||||||
|
(every? #(< (js/Math.abs %) 1e-9) (map - a b)))
|
||||||
|
|
||||||
|
(deftest the-origin-picks-the-measured-frame-a-head-reads
|
||||||
|
(let [at (fn [t fs] (map #(trace/held-frame (trace/prepare t) %) fs))]
|
||||||
|
(is (nil? (trace/prepare {:frames [4 9] :origin :continuous})))
|
||||||
|
(is (nil? (trace/prepare nil)))
|
||||||
|
(is (= [0 0 0] (at {:frames [4 9] :origin :start} [0 5 50])))
|
||||||
|
(is (= [4 4 4 4 9 9] (at {:frames [4 9] :origin :keys} [0 3 4 8 9 50]))
|
||||||
|
"a jump at each key, and before the first the first")
|
||||||
|
(is (= [0 0] (at {:frames [] :origin :keys} [0 30])))))
|
||||||
|
|
||||||
|
(deftest every-origin-is-a-valid-document-that-saves
|
||||||
|
(doseq [origin trace/origins
|
||||||
|
:let [c (traced {:frames [0 12 40] :origin origin})]]
|
||||||
|
(is (empty? (clip/problems c)) (str origin ": " (pr-str (clip/problems c))))
|
||||||
|
(is (= c (leaf/clip "t" (leaf/leaves "t" c))) (str origin " round-trips"))))
|
||||||
|
|
||||||
|
(deftest a-trace-the-take-cannot-hold-will-not-save
|
||||||
|
(doseq [t [{:frames [0] :origin :sideways} {:frames [9 3] :origin :keys}
|
||||||
|
{:frames [9999] :origin :keys}]]
|
||||||
|
(is (seq (clip/problems (traced t))) (pr-str t))))
|
||||||
|
|
||||||
|
(deftest the-photo-holds-each-trace-frame-until-the-next
|
||||||
|
(let [t {:frames [5 20]}]
|
||||||
|
(is (= [5 5 5 5 20 20] (map #(trace/photo-frame t %) [0 4 5 19 20 90]))))
|
||||||
|
(is (= 33 (trace/photo-frame {:frames []} 33)) "no keys: every frame is its own")
|
||||||
|
(is (= [3 7] (:frames (trace/toggle-frame {:frames [7]} 3))))
|
||||||
|
(is (= [] (:frames (trace/toggle-frame {:frames [7]} 7)))))
|
||||||
|
|
||||||
|
(defn- photo-at
|
||||||
|
"The photo matrix of face-1 alone at frame `f`, the still being 1000px tall."
|
||||||
|
[c f]
|
||||||
|
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of)
|
||||||
|
h (head c)]
|
||||||
|
(r f)
|
||||||
|
(vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store
|
||||||
|
(trace/photo-frame (trace/of h) f) 1000)))))
|
||||||
|
|
||||||
|
(deftest the-photo-registers-to-the-face-it-was-filmed-with
|
||||||
|
;; Face-1 is its own symbol and its head is its root, so a photo sitting where
|
||||||
|
;; it was filmed is image pixels over image height and nothing else.
|
||||||
|
(let [filmed [0.001 0 0 0.001 0 0]]
|
||||||
|
(is (near? filmed (photo-at (traced {:frames [] :origin :continuous}) 30))
|
||||||
|
"a head showing the photo's own frame cancels out")
|
||||||
|
(is (near? filmed (photo-at (traced {:frames [12] :origin :keys}) 30))
|
||||||
|
"held at the trace frame, face and photo both stand still")
|
||||||
|
(is (not (near? filmed (photo-at (traced {:frames [12] :origin :continuous}) 30)))
|
||||||
|
"a continuous head carries the held photo along with it")))
|
||||||
|
|
||||||
|
(defn- wrapped
|
||||||
|
"Face-1's take placed, moved, inside a symbol :wrap, with `underlays` on the
|
||||||
|
instances named."
|
||||||
|
[{:keys [outer inner]}]
|
||||||
|
(-> @frozen
|
||||||
|
(assoc-in [:symbols :wrap] {:id :wrap :frames 200
|
||||||
|
:nodes {:m (cond-> {:id :m :kind :instance :of :main :z "a0"
|
||||||
|
:channels {[:xform :pos] {:animated? false
|
||||||
|
:value [30 -10]}}}
|
||||||
|
outer (assoc :underlay outer))}})
|
||||||
|
(cond-> inner (assoc-in [:symbols :main :nodes :face-1 :underlay] inner))))
|
||||||
|
|
||||||
|
(deftest an-underlay-covers-the-faces-below-it-and-the-nearest-decides
|
||||||
|
(is (= [{:path [:m :face-1] :face :face-1 :opacity 0.3}]
|
||||||
|
(trace/shown (wrapped {:outer {:on? true :opacity 0.3}}) :wrap))
|
||||||
|
"switched on at the take, its face shows")
|
||||||
|
(is (= [] (trace/shown (wrapped {:outer {:on? true} :inner {:on? false}}) :wrap))
|
||||||
|
"and the face can still be switched off inside it")
|
||||||
|
(is (= [{:path [:m :face-1] :face :face-1 :opacity 0.8}]
|
||||||
|
(trace/shown (wrapped {:inner {:on? true :opacity 0.8}}) :wrap)))
|
||||||
|
(let [c (wrapped {:outer {:on? true :opacity 0.3}})]
|
||||||
|
(is (= {:on? true :opacity 0.3 :own? false} (trace/underlay-at c :wrap [:m :face-1])))
|
||||||
|
(is (= {:on? true :opacity 0.3 :own? true} (trace/underlay-at c :wrap [:m])))
|
||||||
|
(is (nil? (trace/underlay-at @frozen :main [:face-1])))))
|
||||||
|
|
||||||
|
(deftest a-take-lists-the-faces-in-it
|
||||||
|
(is (= [{:path [:face-1] :in :main :face :face-1}] (trace/faces @frozen :main)))
|
||||||
|
(is (= [{:path [:m :face-1] :in :main :face :face-1}] (trace/faces (wrapped {}) :wrap)))
|
||||||
|
(is (= [] (trace/faces @frozen :face-1))))
|
||||||
|
|
||||||
|
(deftest the-resolver-says-where-a-nested-head-went-on-its-last-frame
|
||||||
|
;; The same answer as `nest/placement`, which walks and resolves the path all
|
||||||
|
;; over again — the resolver has it already, from drawing the frame.
|
||||||
|
(let [c (wrapped {})
|
||||||
|
r (clip/resolver c @store pal/index-of :wrap)
|
||||||
|
path [:m :face-1 :head]]
|
||||||
|
(doseq [f [0 17 60]]
|
||||||
|
(r f)
|
||||||
|
(let [pl (nest/placement c @store :wrap path f)]
|
||||||
|
(is (near? (array-seq (:world pl)) (array-seq (symbol/world-of r path))) (str f))
|
||||||
|
(is (= (:frame pl) (js/Math.floor (symbol/frame-of r path))) (str f))))
|
||||||
|
(r 500)
|
||||||
|
(is (nil? (symbol/world-of r path)) "not on the frame, not anywhere")))
|
||||||
|
|
@ -78,12 +78,10 @@
|
||||||
;; before the data is trusted — which is what it is for. It checks the clip's
|
;; 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
|
;; fields, every timeline in it and the tracking identities, so it is the whole
|
||||||
;; of what a save would refuse.
|
;; of what a save would refuse.
|
||||||
(doseq [spec [{:mode :free} {:mode :anchored :anchors {0 0}}]]
|
(doseq [spec [{} {:trace {:origin :start}} {:trace {:origin :continuous :frames [4]}}
|
||||||
|
{:trace {:origin :keys :frames [12 88 150]}}]]
|
||||||
(let [c (freeze/head-mode spec @frozen)]
|
(let [c (freeze/head-mode spec @frozen)]
|
||||||
(is (empty? (clip/problems c)) (str spec ": " (pr-str (clip/problems c))))))
|
(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)]
|
|
||||||
(is (empty? (clip/problems c)) (pr-str (clip/problems c)))))
|
|
||||||
|
|
||||||
(deftest the-tree-is-the-one-the-model-specifies
|
(deftest the-tree-is-the-one-the-model-specifies
|
||||||
(is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face)))
|
(is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face)))
|
||||||
|
|
@ -194,7 +192,7 @@
|
||||||
;; of the two says it is. A test that recomputed the chain would only be
|
;; 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!`
|
;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
|
||||||
;; and `emit` as well.
|
;; and `emit` as well.
|
||||||
(let [c (freeze/head-mode {:mode :free} @frozen)
|
(let [c (freeze/head-mode {} @frozen)
|
||||||
res (clip/resolver c @store pal/index-of :main)
|
res (clip/resolver c @store pal/index-of :main)
|
||||||
k (first (:value (chan :face [:xform :scale])))
|
k (first (:value (chan :face [:xform :scale])))
|
||||||
anc (:value (chan :face [:xform :anchor]))
|
anc (:value (chan :face [:xform :anchor]))
|
||||||
|
|
@ -232,48 +230,48 @@
|
||||||
"], the composition says [" wx " " wy "]"))))))
|
"], the composition says [" wx " " wy "]"))))))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; one dense measurement, with optional held anchor frames
|
;; one dense measurement, with optional held trace frames
|
||||||
|
|
||||||
(deftest head-anchors-select-measured-frames-without-copying-channels
|
(deftest a-head-trace-selects-measured-frames-without-copying-channels
|
||||||
(let [free (freeze/head-mode {:mode :free} @frozen)
|
(let [free (freeze/head-mode {} @frozen)
|
||||||
one (freeze/head-mode {:mode :anchored :anchors {0 12}} @frozen)
|
one (freeze/head-mode {:trace {:origin :keys :frames [12]}} @frozen)
|
||||||
keyed (freeze/head-mode {:mode :anchored
|
keyed (freeze/head-mode {:trace {:origin :keys :frames [12 88 150]}} @frozen)
|
||||||
:anchors {0 12, 40 88, 150 150}} @frozen)
|
|
||||||
of (fn [c path] (get-in (nodes c) [:head :channels path]))]
|
of (fn [c path] (get-in (nodes c) [:head :channels path]))]
|
||||||
(doseq [c [free one keyed]
|
(doseq [c [free one keyed]
|
||||||
path [[:xform :pos] [:xform :rot] [:xform :scale]]]
|
path [[:xform :pos] [:xform :rot] [:xform :scale]]]
|
||||||
(is (= :dense (ch/describe (of c path))))
|
(is (= :dense (ch/describe (of c path))))
|
||||||
(is (= (of free path) (of c path)) "anchor edits do not copy measurements"))
|
(is (= (of free path) (of c path)) "a trace does not copy measurements"))
|
||||||
(is (nil? (get-in (nodes free) [:head :anchors])))
|
(is (nil? (get-in (nodes free) [:head :trace])))
|
||||||
(is (= {0 12} (get-in (nodes one) [:head :anchors])))
|
(is (= {:frames [12] :origin :keys} (get-in (nodes one) [:head :trace])))
|
||||||
(is (= {0 12, 40 88, 150 150}
|
|
||||||
(get-in (nodes keyed) [:head :anchors])))
|
|
||||||
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
|
(is (= keyed (leaf/clip "head" (leaf/leaves "head" keyed)))
|
||||||
"anchor source addresses survive the document round trip")))
|
"the trace survives the document round trip")))
|
||||||
|
|
||||||
(deftest head-anchor-keys-hold-the-whole-measured-transform
|
(deftest trace-keys-hold-the-whole-measured-transform
|
||||||
(let [free (symbol/resolver (face-symbol
|
(let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen))
|
||||||
(freeze/head-mode {:mode :free} @frozen))
|
@store pal/index-of)
|
||||||
@store pal/index-of)
|
|
||||||
held (symbol/resolver (face-symbol
|
held (symbol/resolver (face-symbol
|
||||||
(freeze/head-mode {:mode :anchored
|
(freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen))
|
||||||
:anchors {0 12, 40 88}} @frozen))
|
@store pal/index-of)
|
||||||
@store pal/index-of)
|
start (symbol/resolver (face-symbol
|
||||||
|
(freeze/head-mode {:trace {:origin :start :frames [12 88]}} @frozen))
|
||||||
|
@store pal/index-of)
|
||||||
world (fn [resolver frame]
|
world (fn [resolver frame]
|
||||||
(resolver frame)
|
(resolver frame)
|
||||||
(vec (array-seq (symbol/world-of resolver :head))))]
|
(vec (array-seq (symbol/world-of resolver :head))))]
|
||||||
(is (= (world free 12) (world held 0)))
|
(is (= (world free 12) (world held 0)) "before the first key, the first holds")
|
||||||
(is (= (world free 12) (world held 38)))
|
(is (= (world free 12) (world held 87)))
|
||||||
(is (= (world free 88) (world held 40)))
|
(is (= (world free 88) (world held 88)) "a jump, not a tween")
|
||||||
(is (= (world free 88) (world held 100)))))
|
(is (= (world free 88) (world held 100)))
|
||||||
|
(is (not= (world free 0) (world free 100)) "the head does move, so the above says something")
|
||||||
|
(is (= (world free 0) (world start 50) (world start 100)))))
|
||||||
|
|
||||||
(deftest switching-modes-rewrites-the-head-and-nothing-else
|
(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 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
|
;; it has to be a DOCUMENT edit: tier 1, undoable, syncable, instant, and not a
|
||||||
;; reason to re-analyse.
|
;; reason to re-analyse.
|
||||||
(let [a (freeze/head-mode {:mode :free} @frozen)
|
(let [a (freeze/head-mode {} @frozen)
|
||||||
b (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen)
|
b (freeze/head-mode {:trace {:origin :start}} @frozen)
|
||||||
c (freeze/head-mode {:mode :anchored :anchors {0 0, 40 40}} @frozen)]
|
c (freeze/head-mode {:trace {:origin :keys :frames [0 40]}} @frozen)]
|
||||||
(doseq [x [b c]]
|
(doseq [x [b c]]
|
||||||
(is (= (get (nodes a) :face) (get (nodes x) :face))
|
(is (= (get (nodes a) :face) (get (nodes x) :face))
|
||||||
":face moved")
|
":face moved")
|
||||||
|
|
@ -287,14 +285,17 @@
|
||||||
;; channels, so the clip's own fields and its other timelines are untouched.
|
;; channels, so the clip's own fields and its other timelines are untouched.
|
||||||
(is (= (dissoc a :symbols) (dissoc x :symbols))))))
|
(is (= (dissoc a :symbols) (dissoc x :symbols))))))
|
||||||
|
|
||||||
(deftest invalid-head-anchor-maps-are-refused
|
(deftest invalid-head-traces-are-refused
|
||||||
(is (thrown-with-msg? ExceptionInfo #"free or anchored"
|
(doseq [t [{} {:origin :stabilised} {:origin :keys :frames [take/frames]}
|
||||||
(freeze/head-mode {:mode :stabilised} @frozen)))
|
{:origin :keys :frames [-1]} {:origin :keys :frames [12 4]}
|
||||||
(doseq [anchors [nil {} {12 12} {0 take/frames} {0 0, 10 -1}]]
|
{:origin :keys :frames [4 4]} {:origin :keys :frames '(4)}]]
|
||||||
(is (thrown-with-msg? ExceptionInfo #"frame-zero key"
|
(is (thrown-with-msg? ExceptionInfo #"trace is not one this take can hold"
|
||||||
(freeze/head-mode {:mode :anchored :anchors anchors} @frozen))))
|
(freeze/head-mode {:trace t} @frozen))
|
||||||
(is (thrown-with-msg? ExceptionInfo #"has no anchors"
|
(pr-str t)))
|
||||||
(freeze/head-mode {:mode :free :anchors {0 0}} @frozen))))
|
(is (seq (clip/problems (assoc-in (freeze/head-mode {} @frozen)
|
||||||
|
[:symbols :face-1 :nodes :head :trace]
|
||||||
|
{:origin :keys :frames [take/frames]})))
|
||||||
|
"and a document holding one will not save"))
|
||||||
|
|
||||||
;; ---------------------------------------------------------------------------
|
;; ---------------------------------------------------------------------------
|
||||||
;; the face: authored, and what makes makeXform deletable
|
;; the face: authored, and what makes makeXform deletable
|
||||||
|
|
@ -598,7 +599,7 @@
|
||||||
;; from different beats are genuinely different mouths and frames inside one
|
;; 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
|
;; 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.
|
;; 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 {:trace {:origin :start}} @frozen)
|
||||||
shot (fn [f]
|
shot (fn [f]
|
||||||
(let [r (raster/make W H)
|
(let [r (raster/make W H)
|
||||||
mouth (filter #(= [:face-1 :mouth] (:node %))
|
mouth (filter #(= [:face-1 :mouth] (:node %))
|
||||||
|
|
@ -616,6 +617,6 @@
|
||||||
(is (< (differ (shot 10) (shot 12)) 200)
|
(is (< (differ (shot 10) (shot 12)) 200)
|
||||||
"a held pose is moving more than the detector noise it should have lost"))
|
"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.
|
;; As filmed, the head carries it around the stage as well.
|
||||||
(let [filmed (freeze/head-mode {:mode :free} @frozen)]
|
(let [filmed (freeze/head-mode {} @frozen)]
|
||||||
(is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300)
|
(is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300)
|
||||||
"the head does not move across the take")))
|
"the head does not move across the take")))
|
||||||
|
|
|
||||||
|
|
@ -20,7 +20,7 @@
|
||||||
(def frames 40)
|
(def frames 40)
|
||||||
(def settings
|
(def settings
|
||||||
(merge take/knobs {:name "two faces" :fps 30 :aspect 1 :stage [320 200]
|
(merge take/knobs {:name "two faces" :fps 30 :aspect 1 :stage [320 200]
|
||||||
:fit-motion? true :expose 1 :head :anchored :anchors {0 0}
|
:fit-motion? true :expose 1 :trace {:origin :start}
|
||||||
:analysis (address/analysis {:detector "synth" :version "two-faces-v1"
|
:analysis (address/analysis {:detector "synth" :version "two-faces-v1"
|
||||||
:seed 9 :frames frames :fps 30 :aspect 1})}))
|
:seed 9 :frames frames :fps 30 :aspect 1})}))
|
||||||
(def inputs
|
(def inputs
|
||||||
|
|
@ -62,13 +62,13 @@
|
||||||
(assoc-in clip [:features :duplicate]
|
(assoc-in clip [:features :duplicate]
|
||||||
(assoc (get-in clip [:features :face-2/mouth]) :id :duplicate)))))))
|
(assoc (get-in clip [:features :face-2/mouth]) :id :duplicate)))))))
|
||||||
|
|
||||||
(deftest one-subjects-edit-and-anchor-do-not-change-its-neighbor
|
(deftest one-subjects-edit-and-trace-do-not-change-its-neighbor
|
||||||
(let [before @initial
|
(let [before @initial
|
||||||
at [:clip :symbols :face-2 :nodes :iris-r :channels [:style :color]]
|
at [:clip :symbols :face-2 :nodes :iris-r :channels [:style :color]]
|
||||||
before (assoc-in before at (ch/framed :brow))
|
before (assoc-in before at (ch/framed :brow))
|
||||||
after (regenerate/change before {:scope :feature :id :face-2/eye-r
|
after (regenerate/change before {:scope :feature :id :face-2/eye-r
|
||||||
:knob :gaze-gain :value 2})
|
:knob :gaze-gain :value 2})
|
||||||
anchored (freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 12}} after)]
|
anchored (freeze/head-mode {:subject :face-2 :trace {:origin :keys :frames [12]}} after)]
|
||||||
(is (= (get-in before at) (get-in after at)) "authored channels survive regeneration")
|
(is (= (get-in before at) (get-in after at)) "authored channels survive regeneration")
|
||||||
(is (= (get-in before [:clip :symbols :face-1])
|
(is (= (get-in before [:clip :symbols :face-1])
|
||||||
(get-in after [:clip :symbols :face-1])
|
(get-in after [:clip :symbols :face-1])
|
||||||
|
|
@ -77,7 +77,7 @@
|
||||||
(channel after :face-2 :iris-r [:xform :pos])))
|
(channel after :face-2 :iris-r [:xform :pos])))
|
||||||
(is (= (channel before :face-2 :iris-l [:xform :pos])
|
(is (= (channel before :face-2 :iris-l [:xform :pos])
|
||||||
(channel after :face-2 :iris-l [:xform :pos])))
|
(channel after :face-2 :iris-l [:xform :pos])))
|
||||||
(is (= {0 12} (get-in anchored [:symbols :face-2 :nodes :head :anchors])))
|
(is (= {:origin :keys :frames [12]} (get-in anchored [:symbols :face-2 :nodes :head :trace])))
|
||||||
(is (empty? (clip/problems anchored)))))
|
(is (empty? (clip/problems anchored)))))
|
||||||
|
|
||||||
(deftest the-second-subject-regenerates-inside-a-composed-stage
|
(deftest the-second-subject-regenerates-inside-a-composed-stage
|
||||||
|
|
@ -92,9 +92,9 @@
|
||||||
(get-in after [:clip :symbols sid]))))
|
(get-in after [:clip :symbols sid]))))
|
||||||
(is (empty? (clip/problems (:clip after))))
|
(is (empty? (clip/problems (:clip after))))
|
||||||
(is (thrown? ExceptionInfo
|
(is (thrown? ExceptionInfo
|
||||||
(freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 frames}}
|
(freeze/head-mode {:subject :face-2 :trace {:origin :keys :frames [frames]}}
|
||||||
after))
|
after))
|
||||||
"anchors are bounded by the source timeline, even on a longer stage")))
|
"trace frames are bounded by the source timeline, even on a longer stage")))
|
||||||
|
|
||||||
(deftest an-instance-pose-cut-only-holds-that-faces-mouth
|
(deftest an-instance-pose-cut-only-holds-that-faces-mouth
|
||||||
(let [{:keys [clip store]} @initial
|
(let [{:keys [clip store]} @initial
|
||||||
|
|
@ -114,7 +114,7 @@
|
||||||
(assoc-in [:face-2 :presence :eye-r]
|
(assoc-in [:face-2 :presence :eye-r]
|
||||||
(assoc (vec (repeat frames true)) 12 false)))
|
(assoc (vec (repeat frames true)) 12 false)))
|
||||||
{:keys [clip store]} (take/build settings inputs)
|
{:keys [clip store]} (take/build settings inputs)
|
||||||
clip (freeze/head-mode {:mode :free} {:clip clip})
|
clip (freeze/head-mode {} {:clip clip})
|
||||||
at8 (by-node clip store 8)
|
at8 (by-node clip store 8)
|
||||||
at12 (by-node clip store 12)]
|
at12 (by-node clip store 12)]
|
||||||
(is (some? (get at8 [:face-1 :mouth])))
|
(is (some? (get at8 [:face-1 :mouth])))
|
||||||
|
|
|
||||||
|
|
@ -502,6 +502,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
|
||||||
.stage { display: block; background: var(--stage); }
|
.stage { display: block; background: var(--stage); }
|
||||||
|
|
||||||
.paint-overlay { position: absolute; inset: 0; touch-action: none; }
|
.paint-overlay { position: absolute; inset: 0; touch-action: none; }
|
||||||
|
/* The footage traced over: a reference above the picture, never part of it. */
|
||||||
|
.underlay { position: absolute; inset: 0; pointer-events: none; }
|
||||||
.paint-overlay.drawing { cursor: crosshair; }
|
.paint-overlay.drawing { cursor: crosshair; }
|
||||||
.paint-overlay circle { cursor: grab; }
|
.paint-overlay circle { cursor: grab; }
|
||||||
|
|
||||||
|
|
@ -615,6 +617,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
|
||||||
.tl-track { position: relative; }
|
.tl-track { position: relative; }
|
||||||
|
|
||||||
.tl-label {
|
.tl-label {
|
||||||
|
/* Scrolled to from the stage: clear of the sticky ruler above. */
|
||||||
|
scroll-margin-top: var(--ruler);
|
||||||
display: flex;
|
display: flex;
|
||||||
align-items: center;
|
align-items: center;
|
||||||
gap: 3px;
|
gap: 3px;
|
||||||
|
|
@ -680,6 +684,16 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
|
||||||
line-height: var(--ruler);
|
line-height: var(--ruler);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* The heading between the picture's rows and the sounds', as an editor puts
|
||||||
|
its audio tracks under its video tracks. */
|
||||||
|
.tl-label.tl-section,
|
||||||
|
.tl-track.tl-section { background: var(--chrome); border-top: 1px solid var(--line); }
|
||||||
|
.tl-label.tl-section { padding-left: 6px; color: var(--dim); font-size: 10px; text-transform: uppercase; letter-spacing: 0.06em; }
|
||||||
|
|
||||||
|
/* A sound's bar, told apart from the picture's at a glance. */
|
||||||
|
.tl-span.sound { background: #e3efdf; border-color: #a6c49b; }
|
||||||
|
.pool-item .thumb.sound { display: flex; align-items: center; justify-content: center; color: #d9d9d9; }
|
||||||
|
|
||||||
/* The span the node exists over. Drawn under the keys so a dot on the first
|
/* The span the node exists over. Drawn under the keys so a dot on the first
|
||||||
frame of a span is not half-hidden by its own bar. */
|
frame of a span is not half-hidden by its own bar. */
|
||||||
.tl-span {
|
.tl-span {
|
||||||
|
|
@ -832,3 +846,11 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
|
||||||
.facts dd.channel .key { padding: 0 3px; color: var(--dim); }
|
.facts dd.channel .key { padding: 0 3px; color: var(--dim); }
|
||||||
.facts dd.channel .key.keyed { color: var(--fg); }
|
.facts dd.channel .key.keyed { color: var(--fg); }
|
||||||
.facts dd.channel .key.on { color: var(--sel); }
|
.facts dd.channel .key.on { color: var(--sel); }
|
||||||
|
|
||||||
|
/* The selected node's transform box, in stage pixels (the SVG's viewBox). */
|
||||||
|
.paint-overlay .handles .box { fill: none; stroke: #e6ca8b; stroke-width: 0.5; stroke-dasharray: 2 1; pointer-events: none; }
|
||||||
|
.paint-overlay .handles .knob-arm { stroke: #e6ca8b; stroke-width: 0.5; pointer-events: none; }
|
||||||
|
.paint-overlay .handles .knob { fill: #161820; stroke: #fff1be; stroke-width: 0.6; cursor: grab; }
|
||||||
|
.paint-overlay .handles .corner { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: nwse-resize; }
|
||||||
|
.paint-overlay .handles .pivot { stroke: #fff1be; stroke-width: 0.6; pointer-events: none; }
|
||||||
|
.paint-overlay:focus { outline: none; }
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue