diff --git a/clips/extraction.py b/clips/extraction.py index ff31bb6..21d07a6 100644 --- a/clips/extraction.py +++ b/clips/extraction.py @@ -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 +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): """What the upload is, as far as choosing a proxy rate goes. diff --git a/clips/migrations/0010_sounds.py b/clips/migrations/0010_sounds.py new file mode 100644 index 0000000..1f26395 --- /dev/null +++ b/clips/migrations/0010_sounds.py @@ -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')), + ], + ), + ] diff --git a/clips/models.py b/clips/models.py index 47f1990..b7b4ea1 100644 --- a/clips/models.py +++ b/clips/models.py @@ -52,6 +52,18 @@ class Source(models.Model): 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): """One requested decode of a source into immutable footage.""" diff --git a/clips/tests/test_api.py b/clips/tests/test_api.py index 5db496c..757acd4 100644 --- a/clips/tests/test_api.py +++ b/clips/tests/test_api.py @@ -34,7 +34,7 @@ from django.core.management import call_command from django.test import TestCase, override_settings 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-") @@ -721,6 +721,36 @@ class UploadTests(TestCase): self.assertEqual(27, job.progress) 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): with tempfile.TemporaryDirectory() as directory: path = Path(directory) / "four-frames.mp4" diff --git a/clips/urls.py b/clips/urls.py index b21032b..19cee07 100644 --- a/clips/urls.py +++ b/clips/urls.py @@ -22,6 +22,8 @@ urlpatterns = [ path("logout", views.logout), path("detector", views.detector), path("sources", views.sources), + path("sounds", views.sounds), + path("sounds/", views.sound_detail), path("extractions", views.extractions), path("extractions/", views.extraction_detail), path("footage", views.footage_list), diff --git a/clips/views.py b/clips/views.py index 2b91348..44edd2d 100644 --- a/clips/views.py +++ b/clips/views.py @@ -43,7 +43,7 @@ from django.views.decorators.http import require_http_methods from . import blobs, extraction from .consumers import broadcast -from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Leaf, Project, Revision, Source +from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Leaf, Project, Revision, Sound, Source KEY_LENGTH = 71 # "sha256:" + 64 hex @@ -225,6 +225,41 @@ def sources(request): 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): return {"key": row.key, "source": str(row.source_id), "state": row.state, "progress": row.progress, "error": row.error, diff --git a/docs/timing-model.md b/docs/timing-model.md index 608266e..b5a17eb 100644 --- a/docs/timing-model.md +++ b/docs/timing-model.md @@ -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 | | 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 | | Stage pose cuts | Symbol instance | Implemented, stored with the instance | diff --git a/frontend/src/arthur/audio/mix.cljs b/frontend/src/arthur/audio/mix.cljs index 06b2bcd..adec0d7 100644 --- a/frontend/src/arthur/audio/mix.cljs +++ b/frontend/src/arthur/audio/mix.cljs @@ -55,26 +55,36 @@ (js/URL.createObjectURL (js/Blob. #js [(wav-bytes buffer)] #js {:type "audio/wav"}))) -(defn- source! [footage-id] - (-> (js/fetch (str "/api/footage/" footage-id)) +(defn- fetch-ok! [url what] + (-> (js/fetch url) (.then (fn [response] (when-not (.-ok response) - (throw (ex-info "audio track's footage is missing" - {:footage footage-id :status (.-status response)}))) - (.json response))) - (.then (fn [^js manifest] - (-> (js/fetch (.-audio manifest)) - (.then (fn [response] - (when-not (.-ok response) - (throw (ex-info "audio track's blob is missing" - {:footage footage-id :status (.-status response)}))) - (.arrayBuffer response))) - (.then (fn [bytes] - (let [decoder (js/OfflineAudioContext. 1 1 44100)] - (-> (.decodeAudioData decoder bytes) - (.then (fn [buffer] - [footage-id {:buffer buffer - :fps (.-fps manifest)}]))))))))))) + (throw (ex-info (str "audio track's " what " is missing") + {:url url :status (.-status response)}))) + response)))) + +(defn- decode-bytes! [bytes] + (.decodeAudioData (js/OfflineAudioContext. 1 1 44100) bytes)) + +(defn- source! + "Promise of `[source {:buffer :fps}]` for an audio node's `:source`. Footage + counts its frames at its own rate; a sound file has no frames of its own, so + its `:fps` is nil and it counts in the document's." + [{:keys [footage sound] :as source}] + (if sound + (-> (fetch-ok! (str "/api/sounds/" sound) "sound") + (.then #(.json %)) + (.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] (let [channel (or channel (ch/framed default))] @@ -107,7 +117,7 @@ (let [[start end] (or (node/placed-span track) [0 frames]) start (max 0 start) end (min frames end) - {:keys [buffer fps]} (get sources (get-in track [:source :footage])) + {:keys [buffer fps] :or {fps (:fps document)}} (get sources (:source track)) sound (.createBufferSource output) gain (.createGain output) pan (.createStereoPanner output)] @@ -143,7 +153,7 @@ (if (empty? tracks) (js/Promise.resolve nil) (-> (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)))))))) (defn decode! @@ -156,8 +166,7 @@ (throw (ex-info "the clip's audio did not load" {:url url :status (.-status response)}))) (.arrayBuffer response))) - (.then (fn [bytes] - (.decodeAudioData (js/OfflineAudioContext. 1 1 44100) bytes))))) + (.then decode-bytes!))) (defn mix! "Promise of a mixed WAV URL for symbol `sid`, or the original URL when it has diff --git a/frontend/src/arthur/demo/take.cljs b/frontend/src/arthur/demo/take.cljs index dc3e737..07b825d 100644 --- a/frontend/src/arthur/demo/take.cljs +++ b/frontend/src/arthur/demo/take.cljs @@ -95,4 +95,4 @@ (def locked "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))) diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index e854ca2..d4089c5 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -166,7 +166,14 @@ Any symbol can be resolved and none is the default: the frame space is the resolved symbol's own `:frames`, and nested instances inside it still resolve, - because this is the function that knows how to do that." + 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 {:keys [picture-fps] :as opts}] (letfn [(build [sid chain pose-tracks] @@ -182,27 +189,47 @@ children (into {} (for [[id n] nodes :when (= :instance (:kind n))] [id (build (:of n) (conj chain sid) - (get-in n [:playback :tracks]))]))] - (fn [f] - (let [by-id (into {} (map (juxt :node identity)) (own f))] - (into [] - (mapcat - (fn [id] - (let [n (get nodes id)] - (if (= :instance (:kind n)) - (let [m (symbol/world-of own id) - local (symbol/frame-of own id) - target (symbol clip (:of n)) - length (:frames target) - frame (when (and m (number? local)) - (if (get-in n [:time :loop?]) - (mod local length) - local))] - (if (and frame (<= 0 frame) (< frame length)) - (map #(transform-op % m [id]) ((get children id) frame)) - [])) - (when-let [op (get by-id id)] [op])))) - ids))))))] + (get-in n [:playback :tracks]))])) + ;; The instances that were on the last frame. Their resolvers + ;; still hold the frame before whenever they were not. + entered (volatile! #{}) + step (fn [f] + (vreset! entered #{}) + (let [by-id (into {} (map (juxt :node identity)) (own f))] + (into [] + (mapcat + (fn [id] + (let [n (get nodes id)] + (if (= :instance (:kind n)) + (let [m (symbol/world-of own id) + local (symbol/frame-of own id) + target (symbol clip (:of n)) + length (:frames target) + frame (when (and m (number? local)) + (if (get-in n [:time :loop?]) + (mod local length) + local))] + (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)))) (defn center @@ -280,6 +307,27 @@ :value (if point (mapv - point middle) [0 0])} [: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 "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." diff --git a/frontend/src/arthur/domain/gesture.cljs b/frontend/src/arthur/domain/gesture.cljs new file mode 100644 index 0000000..db31b31 --- /dev/null +++ b/frontend/src/arthur/domain/gesture.cljs @@ -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))) diff --git a/frontend/src/arthur/domain/leaf.cljs b/frontend/src/arthur/domain/leaf.cljs index 6269917..d70996f 100644 --- a/frontend/src/arthur/domain/leaf.cljs +++ b/frontend/src/arthur/domain/leaf.cljs @@ -45,8 +45,8 @@ WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are not authored: they are written together by a freeze and replaced together by a re-freeze, and `head-mode` exposes them through `:channels`. The optional - `:anchors` map on the head node chooses which measured frame those channels - read. A leaf per measured + `:trace` on the head node chooses which measured frame those channels read. + A leaf per measured channel would offer a write nobody can make. The authored channels beside them are one leaf each, because a hand writes one at a time. diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs index 598f2e6..9b0aef9 100644 --- a/frontend/src/arthur/domain/nest.cljs +++ b/frontend/src/arthur/domain/nest.cljs @@ -23,16 +23,6 @@ [arthur.domain.palette :as pal] [arthur.domain.symbol :as symbol])) -(defn invert - "The inverse of a 2x3 affine, or nil when it has none — an instance scaled to - nothing has no inside to draw into." - [^js m] - (let [[a b c d e f] (array-seq m) - det (- (* a d) (* b c))] - (when-not (zero? det) - (js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det) - (/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)])))) - (defn- resolved "Node `id` of symbol `sid`, resolved at `frame`: the resolver, which then answers `symbol/world-of` and `symbol/frame-of` for it on that frame. @@ -82,13 +72,35 @@ {:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}} 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 "Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the symbol `path` leads to, so a shape added there lands exactly where it was drawn. `{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside." [clip store sid path f pts] (when-let [{:keys [matrix] :as at} (inside clip store sid path f)] - (when-let [inv (invert matrix)] + (when-let [inv (node/invert matrix)] (let [out (js/Float64Array. 2)] (assoc (select-keys at [:sid :frame]) :pts (into [] (mapcat (fn [[x y]] @@ -221,7 +233,7 @@ there (inside clip store open to f) a (:time here) b (:time there) - inv (some-> there :matrix invert)] + inv (some-> there :matrix node/invert)] (cond (nil? (get-in clip [:symbols (:sid here) :nodes (peek from)])) {:refused "nothing to move"} diff --git a/frontend/src/arthur/domain/node.cljs b/frontend/src/arthur/domain/node.cljs index ad36b3c..5ee917a 100644 --- a/frontend/src/arthur/domain/node.cljs +++ b/frontend/src/arthur/domain/node.cljs @@ -46,7 +46,9 @@ (let [base (into #{[:vis]} xform-paths)] {:group 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]]) ;; 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. @@ -65,10 +67,19 @@ [:xform :anchor] (ch/framed [0.0 0.0]) [: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 - "The node's channels with the transform defaults filled in." + "The node's channels with its kind's defaults filled in." [n] - (merge defaults (:channels n))) + (merge (defaults-of n) (:channels n))) (defn set-channel "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)) :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 ;; @@ -284,6 +305,16 @@ pinv-m (mul! dest pinv-m 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! "out[2i], out[2i+1] := 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")) (and (= k :instance) (nil? (:of n))) (conj "an instance needs :of") - (and (= k :audio) (nil? (get-in n [:source :footage]))) - (conj "an audio instance needs :source :footage") + (and (= k :audio) (not (some (:source n) [:footage :sound]))) + (conj "an audio node needs a :source :footage or :sound") (and (some? (get-in n [:time :rate])) (not (pos? (get-in n [:time :rate])))) (conj ":time :rate must be positive") diff --git a/frontend/src/arthur/domain/paint.cljs b/frontend/src/arthur/domain/paint.cljs index 53f1fe4..d62b91e 100644 --- a/frontend/src/arthur/domain/paint.cljs +++ b/frontend/src/arthur/domain/paint.cljs @@ -26,7 +26,12 @@ :kind :poly :paint? true :parent nil :z z :span [frame end] :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))) (defn add-key [clip sid id frame] @@ -46,13 +51,3 @@ (if (and points (< (inc i) (count points))) (assoc-in clip path (-> points (assoc i x) (assoc (inc i) y))) clip))) - -(defn set-segment-interp [clip 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))) diff --git a/frontend/src/arthur/domain/pick.cljs b/frontend/src/arthur/domain/pick.cljs new file mode 100644 index 0000000..5fedcfd --- /dev/null +++ b/frontend/src/arthur/domain/pick.cljs @@ -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))) diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index 23fbb70..162b72a 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -54,6 +54,7 @@ (:require [arthur.domain.channel :as ch] [arthur.domain.node :as node] [arthur.domain.pose :as pose] + [arthur.domain.trace :as trace] [arthur.domain.palette :as pal])) ;; --------------------------------------------------------------------------- @@ -301,7 +302,6 @@ (case (:kind n) :group nil :instance nil - :audio nil :poly (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 all. That reads as a black stage, or, in a benchmark, as \"0 nodes\" and a flattering number. It happened once while the split was being made, which is why - this is a guard and not a comment." + 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] (let [nodes (:nodes sym)] (when-not (map? nodes) (throw (ex-info (str "not a symbol: :nodes is " (pr-str nodes) " — a clip is not a symbol, its `:symbols` hold them") {:keys (vec (sort-by str (keys sym)))}))) - nodes)) + (into {} (remove #(= :audio (:kind (val %)))) nodes))) (defn- channel-frame - "Anchors select measured frames; marked channels read instance pose choices." - [choices anchors nodes source-fps picture-fps id c lf] + "A trace selects the measured frames its node reads; marked channels read + instance pose choices." + [choices traces nodes source-fps picture-fps id c lf] (cond - (contains? anchors id) - (pose/held-frame (get anchors id) lf lf) + (contains? traces id) + (trace/held-frame (get traces id) lf) (:pose-sampled? c) (pose/source-frame choices @@ -367,10 +371,12 @@ :else lf)) -(defn- prepared-anchors [nodes] +(defn- prepared-traces [nodes] (into {} - (for [[id n] nodes :when (seq (:anchors n))] - [id (vec (sort-by first (:anchors n)))]))) + (for [[id n] nodes + :let [p (trace/prepare (:trace n))] + :when p] + [id p]))) (defn- eval-into "One frame, as a fold over the nodes in topological order. @@ -422,11 +428,11 @@ ([sym f store palette pose-tracks opts] (let [nodes (nodes-of sym) choices (pose/prepare pose-tracks) - anchors (prepared-anchors nodes) + traces (prepared-traces nodes) {:keys [source-fps picture-fps]} opts ord (order nodes)] (eval-into {:read (fn [id path c lf] - (ch/value-at c (channel-frame choices anchors nodes + (ch/value-at c (channel-frame choices traces nodes source-fps picture-fps id c lf) store)) :palette palette @@ -486,7 +492,7 @@ ([sym store palette pose-tracks {:keys [source-fps picture-fps]}] (let [nodes (nodes-of sym) choices (pose/prepare pose-tracks) - anchors (prepared-anchors nodes) + traces (prepared-traces nodes) ord (order nodes) rank (draw-rank nodes ord) cursors (into {} @@ -510,7 +516,7 @@ placed (volatile! {}) ctx {:read (fn [id path c lf] (ch/sample! (get-in cursors [id path]) - (channel-frame choices anchors nodes + (channel-frame choices traces nodes source-fps picture-fps id c lf))) :palette palette :mat-for (fn [id] (get mats id)) @@ -578,19 +584,14 @@ (into (for [[id n] nodes p (node/problems n)] (str "node " (pr-str id) ": " p))) - ;; Anchors re-address the node's measurement, regardless of its name. + ;; A trace re-addresses the node's measurement, regardless of its name. (into (for [[id n] nodes - :let [anchors (:anchors n)] - :when (some? anchors) - :when (not (and (map? anchors) (contains? anchors 0) - (integer? (:frames sym)) - (every? #(and (integer? %) (<= 0 %) - (< % (:frames sym))) - (concat (keys anchors) (vals anchors))) - (seq (:measured n)) - (= (:channels n) (:measured n))))] - (str "node " (pr-str id) - ": :anchors must start at frame 0, name valid measured frames, and read that node's own measured channels"))) + :when (some? (:trace n)) + p (if (and (integer? (:frames sym)) (seq (:measured n)) + (= (:channels n) (:measured n))) + (trace/problems (:trace n) (:frames sym)) + ["a trace reads the node's own measured channels"])] + (str "node " (pr-str id) ": " p))) (into (for [k (remove symbol-keys (keys sym))] (str "symbol has a field with no leaf to save it in: " (pr-str k)))) (into (when-not (or (nil? (:frames sym)) (and (integer? (:frames sym)) (pos? (:frames sym)))) diff --git a/frontend/src/arthur/domain/trace.cljs b/frontend/src/arthur/domain/trace.cljs new file mode 100644 index 0000000..55179e5 --- /dev/null +++ b/frontend/src/arthur/domain/trace.cljs @@ -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)))) diff --git a/frontend/src/arthur/events/footage.cljs b/frontend/src/arthur/events/footage.cljs index 217eb92..d353d29 100644 --- a/frontend/src/arthur/events/footage.cljs +++ b/frontend/src/arthur/events/footage.cljs @@ -310,8 +310,10 @@ (rf/reg-fx ::list! (fn [_] - (-> (ingest/available!) - (.then (fn [footage] (rf/dispatch [::listed footage]))) + (-> (js/Promise.all #js [(ingest/available!) + (.then (http/GET "/api/sounds") + #(:sounds (js->clj % :keywordize-keys true)))]) + (.then (fn [[footage sounds]] (rf/dispatch [::listed footage sounds]))) (.catch (fn [error] (rf/dispatch [::failed (or (ex-message error) (str error))])))))) @@ -341,24 +343,38 @@ (.catch (fn [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 ::upload - (fn [{:keys [db]} [_ file]] - (if (or (nil? file) (get-in db [:footage :loading?])) - {} - {:db (update db :footage merge {:loading? true :status "uploading video…"}) - ::upload! file}))) + (fn [{:keys [db]} [_ ^js file]] + ;; By type, and by name for a browser that leaves the type empty. + (let [sound? (and file (or (string/starts-with? (.-type file) "audio/") + (re-find #"(?i)\.(mp3|wav|aiff?|flac|ogg|m4a|aac)$" (.-name 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 ::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 - ;; it into a symbol is a separate decision — which frames, what name — made by - ;; dropping it where it should go. + ;; it into a symbol or a sound is a separate decision — which frames, what + ;; name, where — made by dropping it where it should go. {:db (update db :footage #(-> % - (merge {:loading? false :chosen footage-id - :status "video extracted"}) - (update :uploaded (fnil conj #{}) footage-id))) + (merge {:loading? false :status (or status "video extracted")}) + (cond-> (not status) (assoc :chosen id)) + (update :uploaded (fnil conj #{}) id))) :dispatch [::refresh]})) (rf/reg-event-fx @@ -367,9 +383,10 @@ (rf/reg-event-db ::listed - (fn [db [_ footage]] + (fn [db [_ footage sounds]] (update db :footage merge (cond-> {:available (vec footage) + :sounds (vec sounds) :chosen (or (:chosen (:footage db)) (:id (first footage)))} (empty? footage) (assoc :status "upload a video to begin"))))) diff --git a/frontend/src/arthur/events/paint.cljs b/frontend/src/arthur/events/paint.cljs index 7bf614b..eb3dc1a 100644 --- a/frontend/src/arthur/events/paint.cljs +++ b/frontend/src/arthur/events/paint.cljs @@ -23,8 +23,3 @@ ::set-vertex (fn [db [_ sid id key-frame vertex point]] (edit/edit db #(paint/set-vertex % sid id key-frame vertex point)))) - -(rf/reg-event-db - ::set-segment-interp - (fn [db [_ sid id key-frame interp]] - (edit/edit db #(paint/set-segment-interp % sid id key-frame interp)))) diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index f0c9283..8ae3e69 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -624,6 +624,24 @@ (fn [db [_ sid id 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 ::list (fn [{:keys [db]} _] diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 9fcaed2..e59f872 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -6,6 +6,7 @@ there should not be one: an editor's own state is the cheapest thing in the app to change and the most expensive to have two copies of." (:require [arthur.domain.clip :as clip] + [arthur.domain.gesture :as gesture] [arthur.domain.nest :as nest] [arthur.events.edit :as edit] [arthur.events.paint :as paint] @@ -14,7 +15,18 @@ (rf/reg-event-db ::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 ::set-tone @@ -165,6 +177,16 @@ host sid frame uuid point)) (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 ;; @@ -186,7 +208,8 @@ (-> db (edit/edit (constantly (:clip r))) (assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj to (:id r))]) - (update-in [:ui :expanded] into (rest (reductions conj [] to)))))))) + (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 ::sliding @@ -207,6 +230,32 @@ (:refused r) (refused db (:refused 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 ::delete-selected (fn [db _] diff --git a/frontend/src/arthur/flow/freeze.cljs b/frontend/src/arthur/flow/freeze.cljs index 5b38bb0..90b87c3 100644 --- a/frontend/src/arthur/flow/freeze.cljs +++ b/frontend/src/arthur/flow/freeze.cljs @@ -36,6 +36,7 @@ [arthur.domain.feature :as feature] [arthur.domain.geom :as geom] [arthur.domain.ring :as ring] + [arthur.domain.trace :as trace] [arthur.flow.address :as address])) ;; --------------------------------------------------------------------------- @@ -245,47 +246,38 @@ :tx (* (- s') (+ (* c tx) (* sn ty))) :ty (* (- s') (+ (* (- sn) tx) (* c ty)))})) -(def ^:private head-modes #{:free :anchored}) - (defn head-mode - "Keep a subject's measured transform dense; optionally hold chosen source - frames. + "Keep a subject's measured transform dense; optionally trace it. - A nil anchor map reads measured frame f at frame f (free movement). - `{0 12}` locks to the measured transform of source frame 12. `{0 12, 40 42}` - cuts to source frame 42 at local frame 40. The same map selects position, - rotation and scale, so the head and registered photo cannot drift apart. - No analysis block or authored face placement changes. + With no trace the head reads measured frame f at frame f (free movement). + `{:frames [12] :origin :keys}` holds the measured transform of source frame + 12, `{:frames [12 42] :origin :keys}` jumps to 42's at 42, and `{:origin + :start}` holds frame 0's. See `domain/trace`. The trace selects position, + 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 not. Two faces in one shot were filmed together and are posed apart: choosing frame 12 for the second face must leave the first one running, and it does, - because an anchor map lives on that subject's own head node and - `domain/symbol` reads anchors off whatever node carries them." - [{:keys [subject mode anchors]} {:keys [clip]}] - (when-not (contains? head-modes mode) - (throw (ex-info "head mode must be free or anchored" - {:mode mode :modes head-modes}))) - (when (and (= mode :free) (some? anchors)) - (throw (ex-info "free head motion has no anchors" {:anchors anchors}))) + because a trace lives on that subject's own head node and `domain/symbol` + reads it off whatever node carries it." + [{:keys [subject] t :trace} {:keys [clip]}] (when (and subject (not (contains? (:subjects clip) subject))) (throw (ex-info "head mode names a subject this clip did not track" {:subject subject :subjects (vec (sort-by str (keys (:subjects clip))))}))) - (reduce - (fn [c sid] - (let [frames (get-in c [:symbols sid :frames])] - (when (and (= mode :anchored) - (not (and (map? anchors) (contains? anchors 0) - (every? #(and (integer? %) (<= 0 %) (< % frames)) - (concat (keys anchors) (vals anchors)))))) - (throw (ex-info "anchored head needs a frame-zero key and valid source frames" - {:subject sid :anchors anchors :frames frames}))) - (update-in c [:symbols sid :nodes :head] - (fn [n] - (cond-> (assoc n :channels (:measured n)) - (= mode :anchored) (assoc :anchors anchors) - (= mode :free) (dissoc :anchors)))))) - clip (if subject [subject] (sort-by str (keys (:subjects clip)))))) + (let [t (some->> t (merge {:frames []}))] + (reduce + (fn [c sid] + (let [frames (get-in c [:symbols sid :frames])] + (when-let [why (some-> t (trace/problems frames) first)] + (throw (ex-info (str "a head's trace is not one this take can hold: " why) + {:subject sid :trace t :frames frames}))) + (update-in c [:symbols sid :nodes :head] + (fn [n] + (cond-> (assoc n :channels (:measured n)) + t (assoc :trace t) + (nil? t) (dissoc :trace)))))) + clip (if subject [subject] (sort-by str (keys (:subjects clip))))))) ;; --------------------------------------------------------------------------- ;; the aperture, onto [:vis] of :mouth-in @@ -688,9 +680,9 @@ existing instance scope. Features name local nodes in that subject's symbol; block descriptors still name globally distinct features. - Subjects share a source frame space. :head and :anchors may be overridden - per subject; all other freeze settings come from params." - [{:keys [name fps stage expose head anchors] :as params} subjects] + Subjects share a source frame space. :trace may be overridden per subject; + all other freeze settings come from params." + [{:keys [name fps stage expose] :as params} subjects] (when-not (and (map? subjects) (seq subjects) (every? keyword? (keys subjects)) (not-any? #{:main :root :face} (keys subjects))) @@ -729,7 +721,6 @@ {:subject subject :feature id :frames nf :actual (count track)})))) {:store (merged :store) :clip (reduce (fn [c [subject inputs]] - (head-mode {:subject subject :mode (or (:head inputs) head) - :anchors (get inputs :anchors anchors)} + (head-mode {:subject subject :trace (get inputs :trace (:trace params))} {:clip c})) built ordered)})) diff --git a/frontend/src/arthur/flow/take.cljs b/frontend/src/arthur/flow/take.cljs index d04dd1f..21b1eae 100644 --- a/frontend/src/arthur/flow/take.cljs +++ b/frontend/src/arthur/flow/take.cljs @@ -127,7 +127,7 @@ {:name (or (:source manifest) "footage") :fps (:fps manifest) :aspect (/ w h) :stage [320 200] :fit-motion? true - :expose 1 :head :free + :expose 1 ;; The detector's identity comes from the server, which ;; hashes the model asset it serves rather than trusting a ;; version string somebody has to remember to bump. See diff --git a/frontend/src/arthur/subs/render.cljs b/frontend/src/arthur/subs/render.cljs index a645fde..0454273 100644 --- a/frontend/src/arthur/subs/render.cljs +++ b/frontend/src/arthur/subs/render.cljs @@ -8,8 +8,11 @@ recomputation here and a frame costs a lookup and a blit — and, crucially, the playhead is not an input, so moving it cannot invalidate this." (:require [arthur.domain.clip :as clip] + [arthur.domain.gesture :as gesture] [arthur.domain.nest :as nest] [arthur.domain.palette :as pal] + [arthur.domain.symbol :as symbol] + [arthur.domain.trace :as trace] [arthur.footage.store :as footage] [arthur.subs.playback :as playback] [re-frame.core :as rf])) @@ -19,6 +22,7 @@ (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 ::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 @@ -26,16 +30,30 @@ :<- [::clip-id] :<- [::paint-revision] :<- [::sliding] + :<- [::gesture] :<- [::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 ;; lets go, so the stage and the rows follow the pointer. Nothing is written ;; until then: one drag is one undo step and one write to collaborators. (let [c (:clip (footage/entry id))] (or (when-let [{:keys [path df]} sliding] (:clip (nest/slide c open path df))) + (when-let [{:keys [sid id frame values]} gesture] + (when c (gesture/apply-values c sid id frame values))) 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 ::symbol :<- [::clip] @@ -125,9 +143,32 @@ (if (or (nil? resolve) (empty? solo)) resolve ;; An op inside an instance is named by the path its row has; one at the - ;; top by its bare id. - (fn [f] - (filterv (fn [{n :node}] - (let [p (if (vector? n) n [n])] - (some #(= % (take (count %) p)) solo))) - (resolve f))))))) + ;; top by its bare id. Still the resolver underneath, so where a node + ;; went on the frame is still asked of it. + (reify + IFn + (-invoke [_ 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))))}))) diff --git a/frontend/src/arthur/subs/ui.cljs b/frontend/src/arthur/subs/ui.cljs index 18eb5cf..a00825a 100644 --- a/frontend/src/arthur/subs/ui.cljs +++ b/frontend/src/arthur/subs/ui.cljs @@ -5,6 +5,7 @@ Cheap by construction, like `subs/playback`: each reads a path and returns a value, so clicking a swatch notifies the swatches and nothing else." (:require [arthur.domain.nest :as nest] + [arthur.domain.pick :as pick] [arthur.footage.store :as store] [arthur.subs.playback :as playback] [arthur.subs.render :as render] @@ -19,6 +20,7 @@ (rf/reg-sub ::tabs (fn [db _] (get-in db [:ui :tabs]))) (rf/reg-sub ::expanded (fn [db _] (get-in db [:ui :expanded]))) (rf/reg-sub ::knobs (fn [db _] (get-in db [:ui :knobs]))) +(rf/reg-sub ::points (fn [db _] (get-in db [:ui :points]))) (rf/reg-sub ::selected-node @@ -49,6 +51,23 @@ (let [{clip :clip st :store} (store/entry clip-id)] (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 ::project-footage :<- [::render/clip-id] @@ -67,3 +86,19 @@ :when f] f))] (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)))) diff --git a/frontend/src/arthur/ui/drag.cljs b/frontend/src/arthur/ui/drag.cljs index 130f93c..690dfe3 100644 --- a/frontend/src/arthur/ui/drag.cljs +++ b/frontend/src/arthur/ui/drag.cljs @@ -52,19 +52,24 @@ out of the pool, and not one that would make a cycle." [] (let [c @carrying] - (and c (#{:symbol :footage :import} (:kind c)) (not (:refused? c))))) + (and c (#{:symbol :footage :import :sound} (:kind c)) (not (:refused? c))))) (defn row! - "Start carrying the timeline row at `path` — a node, to be moved into another - symbol or grouped with another node." - [path] - (reset! carrying {:kind :row :path path})) + "Start carrying the timeline row at `path` — a node of kind `node-kind`, to be + moved into another symbol or grouped with another node." + [path node-kind] + (reset! carrying {:kind :row :path path :node-kind node-kind})) (defn row "The path of the row being carried, or nil when it is not a row." [] (let [c @carrying] (when (= :row (:kind c)) (:path c)))) +(defn row-kind + "The node kind of the row being carried." + [] + (:node-kind @carrying)) + (defn other! "Start carrying something that is not yet in the document: `:kind` says what, and the rest is what a preview can show of it before it is fetched." @@ -81,9 +86,10 @@ "Say where the drag would land, for the previews. `point` is nil over the timeline." [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 - :label label :frames frames}]))) + :label label :frames frames + :sound? (= :sound kind)}]))) (defn pos-for "Where the preview goes so the symbol's middle is under `point` — what @@ -102,5 +108,7 @@ ;; the symbol they become is called. :footage (rf/dispatch [::footage/ask-convert 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)) (done!)) diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index 85d74f7..b644da3 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/frontend/src/arthur/ui/params.cljs @@ -13,6 +13,7 @@ [arthur.domain.node :as node] [arthur.domain.paint :as paint] [arthur.domain.params :as params] + [arthur.domain.trace :as trace] [arthur.events.history :as history] [arthur.events.paint :as paint-events] [arthur.events.playback :as pb] @@ -123,6 +124,16 @@ :else (let [v (:value ch)] (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 "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 — @@ -158,23 +169,23 @@ (when next-k [:div.row {:style {:margin-top "5px"}} [:label.dim (str "key " active " → " next-k " ") - [:select {:value (name (or (channel/segment-interp geom active) :hold)) - :on-change #(rf/dispatch [::paint-events/set-segment-interp - sid id active (keyword (.. % -target -value))])} - [:option {:value "hold"} "hold"] - [:option {:value "linear"} "tween"]]]])])) + [segment-select sid id paint/geometry geom active]]])])) ;; The transform and visibility, which every node has, as one row each: ◆ keys ;; the channel here or takes the key here off, and an edit writes a key on a ;; keyed channel or the one value on one that is not. `frame` is the node's own, ;; nil when it is not on screen, where a keyed channel has no here to write to. -;; Rotation is shown in degrees. +;; 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] (let [keyed? (some? (:keys ch)) v (channel/value-at ch (or frame 0)) off? (and keyed? (nil? frame)) 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 %]) field (fn [i x on-number] ^{:key i} @@ -193,7 +204,8 @@ :on-change #(put (.. % -target -checked))}] (number? v) (field 0 v put) :else (doall (map-indexed (fn [i x] (field i x #(put (assoc (vec v) i %)))) - v)))])) + v))) + (when gap? [segment-select sid id path ch left])])) (defn- node-section [[sid id n]] (let [[start end] (:span n)] @@ -217,10 +229,76 @@ ^{:key (str 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] [: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 @@ -346,5 +424,9 @@ [:div {:style {:min-height 0}} [clip-section] (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 tracked? [tracking-section])]])) diff --git a/frontend/src/arthur/ui/player.cljs b/frontend/src/arthur/ui/player.cljs index 9ac0ad8..05dfec1 100644 --- a/frontend/src/arthur/ui/player.cljs +++ b/frontend/src/arthur/ui/player.cljs @@ -19,11 +19,13 @@ times a second at a 30fps clip on a 60Hz display, not sixty — and it carries no global interceptors." (:require [arthur.clock :as clock] + [arthur.domain.pick :as pick] [arthur.domain.raster :as raster] [arthur.events.playback :as pb] [arthur.subs.playback :as sub] [arthur.subs.render :as render] [arthur.ui.canvas :as canvas] + [arthur.ui.underlay :as underlay] [re-frame.core :as rf] [reagent.ratom :as ratom])) @@ -109,6 +111,7 @@ :frames @(rf/subscribe [::render/frames]) :width @(rf/subscribe [::sub/width]) :height @(rf/subscribe [::sub/height]) + :underlay @(rf/subscribe [::render/underlay]) :frame @(rf/subscribe [::sub/frame]) :playing? @(rf/subscribe [::sub/playing?])}) ;; A new resolver means a new scene or a new palette, and neither @@ -129,13 +132,21 @@ raster (: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! "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 rasterised before the next frame is asked for." [f] (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) ;; 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 @@ -145,11 +156,14 @@ ;; independent of the footage, so the size the frame is rasterised at comes ;; out of the document like everything else. (let [ras (raster-for width height)] - (-> ras - (raster/clear! (get palette :bg 0)) - (raster/draw-ops! (resolver f))) + (let [ops (resolver f)] + (swap! state assoc :ops ops) + (-> ras + (raster/clear! (get palette :bg 0)) + (raster/draw-ops! ops))) (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/paint" "arthur/paint:start") ;; User Timing entries otherwise accumulate forever in the browser's diff --git a/frontend/src/arthur/ui/pool.cljs b/frontend/src/arthur/ui/pool.cljs index d792856..d9fc04e 100644 --- a/frontend/src/arthur/ui/pool.cljs +++ b/frontend/src/arthur/ui/pool.cljs @@ -13,6 +13,9 @@ one of another's, and `footage:` for video. The stage and the timeline are where they are dropped. + A SOUND — mp3, wav — is `sound:`, 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 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 @@ -78,6 +81,21 @@ #(drag/other! {:kind :footage :id id :label label :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] (into [:details.pool-folder {:open true} [:summary title]] children)) @@ -90,6 +108,12 @@ selection @(rf/subscribe [::sub/selection]) open @(rf/subscribe [::render/open]) 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])] (folder "this project" (group "symbols" @@ -109,10 +133,15 @@ (group "media" (if (empty? media) [: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 [] - (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 [id]} @(rf/subscribe [::playback/project])] (folder "all assets" @@ -120,6 +149,10 @@ (if (empty? available) [:div.dim "nothing uploaded yet"] (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" (let [others (remove #(= id (:project %)) symbols)] (if (empty? others) @@ -165,11 +198,11 @@ [:div.pane-head "media pool" [:span.spacer] - [:button {:title "add a video" + [:button {:title "add a video or a sound" :disabled loading? :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"} :on-change (fn [^js event] (when-let [file (aget (.. event -target -files) 0)] diff --git a/frontend/src/arthur/ui/shell.cljs b/frontend/src/arthur/ui/shell.cljs index 49b69a9..70a0608 100644 --- a/frontend/src/arthur/ui/shell.cljs +++ b/frontend/src/arthur/ui/shell.cljs @@ -9,6 +9,7 @@ [arthur.ui.convert :as convert] [arthur.events.playback :as pb] [arthur.subs.playback :as playback] + [arthur.subs.render :as render] [arthur.ui.palette :as palette] [arthur.ui.params :as params] [arthur.ui.pool :as pool] @@ -16,19 +17,31 @@ [arthur.ui.tabs :as tabs] [arthur.ui.timeline :as timeline] [arthur.ui.topbar :as topbar] - [re-frame.core :as rf])) + [re-frame.core :as rf] + [reagent.core :as r])) (defn- audio [] - [: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])}]) + ;; An edit to what the open symbol plays — a sound dropped, moved, turned + ;; down, undone — re-mixes the clock. Opening a symbol mixes on its own, so + ;; only a change under the same one counts. + (r/with-let [heard (atom nil) + remix (r/track! (fn [] + (let [[sid :as now] @(rf/subscribe [::render/sounds]) + [was :as before] @heard] + (reset! heard now) + (when (and before (= sid was) (not= now before)) + (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 [] [:div.app diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs index a7c1661..dde9f5a 100644 --- a/frontend/src/arthur/ui/stage.cljs +++ b/frontend/src/arthur/ui/stage.cljs @@ -10,16 +10,20 @@ THE CANVAS IS THE RASTER'S OWN SIZE, scaled by CSS. See `ui/canvas` for why that is load-bearing rather than convenient." (:require [arthur.domain.channel :as channel] + [arthur.domain.gesture :as gesture] [arthur.domain.nest :as nest] [arthur.domain.node :as node] [arthur.domain.paint :as paint] + [arthur.domain.pick :as pick] [arthur.events.paint :as paint-events] [arthur.events.ui :as ui] + [arthur.footage.store :as store] [arthur.subs.playback :as playback] [arthur.subs.render :as render] [arthur.subs.ui :as sub] [arthur.ui.drag :as drag] [arthur.ui.player :as player] + [arthur.ui.underlay :as underlay] [re-frame.core :as rf])) (def ^:const zoom @@ -101,49 +105,181 @@ [:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 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] (let [tool @(rf/subscribe [::sub/tool]) draft @(rf/subscribe [::sub/draft]) 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)))] [:svg {:class (str "paint-overlay" (when drawing? " drawing")) :width (* zoom w) :height (* zoom h) :view-box (str "0 0 " w " " h) - :on-pointer-down (fn [event] - (when drawing? + :tab-index -1 + :on-pointer-down (fn [^js event] + (if drawing? (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] ;; Back through the inverse of what the handle was ;; drawn through, into the shape's own coordinates. - (when-let [[sid node key-frame vertex inv] @dragging] + (if-let [[sid node key-frame vertex inv] @dragging] (rf/dispatch [::paint-events/set-vertex sid node key-frame vertex - (through inv (stage-point event w h))]))) - :on-pointer-up (fn [_] (reset! dragging nil)) - :on-pointer-cancel (fn [_] (reset! dragging nil))} + (through inv (stage-point event w h))]) + (when @gesture + (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] (when (seq draft) [:polyline {:points (points-text draft) :fill "none" :stroke "#d0ba86" :stroke-width 1}]) + (when-not (or drawing? points?) [handles ctx]) (when (and id pts (not drawing?) (not (channel/nothing? pts))) [:g [:polygon {:points (points-text pts) :fill "none" :stroke "#e6ca8b" :stroke-width 1}] - (when-let [inv (when editable? (nest/invert matrix))] + (when-let [inv (when editable? (node/invert matrix))] (doall (for [[i [x y]] (map-indexed vector (pairs pts))] ^{:key i} - [:circle {:cx x :cy y :r 2.6 :fill "#fff1be" - :stroke "#161820" :stroke-width 0.7 - :on-pointer-down - (fn [event] - (.stopPropagation event) - (.preventDefault event) - (.setPointerCapture (.-currentTarget event) - (.-pointerId event)) - (reset! dragging [sid id active i inv]))}])))])])) + [:circle.vertex {:cx x :cy y :r 2.6 :fill "#fff1be" + :stroke "#161820" :stroke-width 0.7 + :on-pointer-down + (fn [event] + (.stopPropagation event) + (.preventDefault event) + (.setPointerCapture (.-currentTarget event) + (.-pointerId event)) + (reset! dragging [sid id active i inv]))}])))])])) (defn view [] ;; Reactive on the clip's dimensions, so selecting a clip of another size @@ -174,4 +310,6 @@ :width w :height h :style {:width (str (* zoom w) "px") :height (str (* zoom h) "px")}}] + [:canvas.underlay {:ref #(underlay/set-canvas! %) + :width (* zoom w) :height (* zoom h)}] [overlay w h]]])) diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 22e190b..2261293 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -1,5 +1,6 @@ (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 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; ;; the id breaks ties so the order is stable. (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 [] (mapcat (fn [[id n]] @@ -133,6 +137,50 @@ (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 ;; @@ -189,21 +237,35 @@ (when (and drop (pos? drop)) (str " · " (.toFixed drop 2) " f/paint")))]])) (defn- takes? - "Whether the row at `target` can take the row being carried: not itself, and - not anything inside it." - [target] + "Whether the row at `target`, a `target-kind` node, can take the row being + carried: not itself, and not anything inside it. A sound goes into a + placement or beside another sound, and only a sound goes beside a sound." + [target target-kind] (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 "Which part of a row the pointer is over: its top edge, to go in front of it; - its bottom edge, to go behind; its middle, to go into it or be grouped with it." - [^js e] + its bottom edge, to go behind; its middle, to go into it or be grouped with it. + Nothing goes into a sound, so its middle is behind it." + [^js e node-kind] (let [box (.getBoundingClientRect (.-currentTarget e)) y (/ (- (.-clientY e) (.-top box)) (max 1 (.-height box)))] - (cond (< y 0.3) :front (> y 0.7) :back :else :into))) + (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] (let [node? (= :node kind) [over-path where] @over] @@ -216,6 +278,7 @@ (if (= :instance node-kind) " drop-into" " drop-group")))) :style {:padding-left (str (+ 4 (* 11 depth)) "px")} :title label + :ref (when (and select (= select selection)) (reveal selection)) :on-click #(when select (rf/dispatch [::ui/select select])) ;; An instance's row opens the symbol it places, as a tab. :on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))} @@ -229,21 +292,21 @@ (.stopPropagation e) (.setData (.-dataTransfer e) "text/plain" "row") (set! (.. e -dataTransfer -effectAllowed) "move") - (drag/row! path)) + (drag/row! path node-kind)) :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] - (when (takes? path) + (when (takes? path node-kind) (.preventDefault e) (.stopPropagation e) (set! (.. e -dataTransfer -dropEffect) "move") - (let [o [path (zone e)]] + (let [o [path (zone e node-kind)]] (when (not= o @over) (reset! over o))))) :on-drop (fn [^js e] (.preventDefault e) (.stopPropagation e) - (let [from (when (takes? path) (drag/row)) - where (zone e)] + (let [from (when (takes? path node-kind) (drag/row)) + where (zone e node-kind)] (reset! over nil) (drag/done!) (when from @@ -259,7 +322,7 @@ (rf/dispatch [::ui/toggle-row path]))} (when expandable? (if expanded? "▾" "▸"))] [: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) [:button {:class (str "tl-solo" (when (contains? solo path) " on")) :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 :df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every row and the stage are drawn from already has in it." - [{:keys [path span keys dense? kind select]} frames sliding] + [{:keys [path span keys dense? kind node-kind select slides]} frames sliding] (let [{from :path x0 :x width :width} @sliding slide (fn [^js e] (when (= path from) (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))] (when (not= df (:df @sliding)) (swap! sliding assoc :df df) - (rf/dispatch [::ui/sliding path df]))))) + (rf/dispatch [::ui/sliding (or slides path) df]))))) done (fn [commit?] (when (= path from) (let [df (:df @sliding)] (reset! sliding nil) - (rf/dispatch (if commit? [::ui/slide path df] [::ui/sliding nil])))))] + (rf/dispatch (if commit? [::ui/slide (or slides path) df] [::ui/sliding nil])))))] [:div.tl-track ;; The track, not the bar, holds the pointer while a bar slides, so the drag ;; goes on when the bar has slid off the ruler and is no longer drawn. @@ -302,6 +365,7 @@ (when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])] (when (< in out) [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost") + (when (= :audio node-kind) " sound") (when select " movable") (when (= path from) " sliding")) :style {:left (edge% in frames) :width (str (* 100 (/ (- out in) (max 1 frames))) "%")} @@ -337,14 +401,24 @@ expanded @(rf/subscribe [::sub/expanded]) drop @(rf/subscribe [::sub/drop]) 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 - ;; top: its own length, starting on the frame it would start on. The - ;; stage's drop shows it too, at the playhead. - visible (cond->> (rows clip @(rf/subscribe [::render/open]) expanded) - drop (cons {:path [::drop] :depth 0 :kind :ghost - :label (str "+ " (:label drop)) - :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))] - :keys []})) + ;; top of its section: its own length, starting on the frame it would + ;; start on. The stage's drop shows it too, at the playhead. + ghost (when drop + {:path [::drop] :depth 0 :kind :ghost + :label (str "+ " (:label drop)) + :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))] + :keys []}) + picture (cond->> (rows clip open expanded) + (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. step (* 10 (js/Math.ceil (/ frames 100)))] [:section.pane.time @@ -365,7 +439,10 @@ (rf/dispatch [::ui/move-node from []]))))} [:div.tl-corner] (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 {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) :on-drag-over (fn [^js e] @@ -411,6 +488,9 @@ [:div.tl-knob {:style {:left (at% frame frames)}}]] (if (seq 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-playhead {:style {:left (at% frame frames)}}]]]]))) diff --git a/frontend/src/arthur/ui/underlay.cljs b/frontend/src/arthur/ui/underlay.cljs new file mode 100644 index 0000000..92c901b --- /dev/null +++ b/frontend/src/arthur/ui/underlay.cljs @@ -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))))))) diff --git a/frontend/test/arthur/domain/gesture_test.cljs b/frontend/test/arthur/domain/gesture_test.cljs new file mode 100644 index 0000000..96ee6e4 --- /dev/null +++ b/frontend/test/arthur/domain/gesture_test.cljs @@ -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))))) diff --git a/frontend/test/arthur/domain/nest_test.cljs b/frontend/test/arthur/domain/nest_test.cljs index bb3f70f..48c7039 100644 --- a/frontend/test/arthur/domain/nest_test.cljs +++ b/frontend/test/arthur/domain/nest_test.cljs @@ -69,7 +69,7 @@ out (js/Float64Array. 2) seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y)))) (partition 2 [0 0 10 0 5 10])) - [x y] (array-seq (node/apply-pt! out 0 (nest/invert matrix) 7 3)) + [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]) 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") @@ -238,3 +238,26 @@ "and nothing else is renumbered") (is (:refused (nest/restack c :main [:a] [a-uuid :inner] true)) "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"))))) diff --git a/frontend/test/arthur/domain/node_test.cljs b/frontend/test/arthur/domain/node_test.cljs index d795949..55dff81 100644 --- a/frontend/test/arthur/domain/node_test.cljs +++ b/frontend/test/arthur/domain/node_test.cljs @@ -157,8 +157,8 @@ (deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them ;; A decomposition is not extensible after the fact: adding a component later ;; means migrating every stored transform. So both are present from the start, - ;; on every kind. - (doseq [k node/implemented-kinds] + ;; on every kind that is in the picture. + (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 :anchor]) (str k)))) @@ -168,7 +168,13 @@ (is (contains? (:disc node/valid-paths) [:geom :radius])) (is (contains? (:rect node/valid-paths) [:geom :size])) (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 (is (empty? (node/problems {:id :x :kind :group :z "a1"}))) @@ -200,4 +206,13 @@ (let [d (node/toggle-key b [:xform :rot] 3)] (is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again") (is (= 1.0 (rot d 0)))) - (is (= :hold (get-in (node/toggle-key n [:vis] 0) [:channels [:vis] :interp])) "a boolean holds"))) + (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")))) diff --git a/frontend/test/arthur/domain/paint_test.cljs b/frontend/test/arthur/domain/paint_test.cljs index 169f6a7..1e019ea 100644 --- a/frontend/test/arthur/domain/paint_test.cljs +++ b/frontend/test/arthur/domain/paint_test.cljs @@ -3,6 +3,7 @@ [arthur.demo :as demo] [arthur.domain.channel :as channel] [arthur.domain.leaf :as leaf] + [arthur.domain.node :as node] [arthur.domain.paint :as paint] [arthur.domain.symbol :as symbol])) @@ -17,7 +18,8 @@ c3 (paint/add-key c2 :main :paint-test 15) c4 (paint/set-vertex c3 :main :paint-test 15 0 [34 10]) held (geometry c4) - mixed-clip (paint/set-segment-interp c4 :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)] (is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span]))) (is (= a (channel/value-at held 8))) diff --git a/frontend/test/arthur/domain/trace_test.cljs b/frontend/test/arthur/domain/trace_test.cljs new file mode 100644 index 0000000..9cc2d9f --- /dev/null +++ b/frontend/test/arthur/domain/trace_test.cljs @@ -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"))) diff --git a/frontend/test/arthur/flow/freeze_test.cljs b/frontend/test/arthur/flow/freeze_test.cljs index a84d4ab..c60c1ec 100644 --- a/frontend/test/arthur/flow/freeze_test.cljs +++ b/frontend/test/arthur/flow/freeze_test.cljs @@ -78,12 +78,10 @@ ;; before the data is trusted — which is what it is for. It checks the clip's ;; fields, every timeline in it and the tracking identities, so it is the whole ;; of what a save would refuse. - (doseq [spec [{:mode :free} {:mode :anchored :anchors {0 0}}]] + (doseq [spec [{} {:trace {:origin :start}} {:trace {:origin :continuous :frames [4]}} + {:trace {:origin :keys :frames [12 88 150]}}]] (let [c (freeze/head-mode spec @frozen)] - (is (empty? (clip/problems c)) (str spec ": " (pr-str (clip/problems c)))))) - (let [c (freeze/head-mode {:mode :anchored - :anchors {0 12, 40 88, 150 150}} @frozen)] - (is (empty? (clip/problems c)) (pr-str (clip/problems c))))) + (is (empty? (clip/problems c)) (str spec ": " (pr-str (clip/problems c))))))) (deftest the-tree-is-the-one-the-model-specifies (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 ;; checking arithmetic against itself; this checks `node/local!`, `node/world!` ;; 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) k (first (:value (chan :face [:xform :scale]))) anc (:value (chan :face [:xform :anchor])) @@ -232,48 +230,48 @@ "], 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 - (let [free (freeze/head-mode {:mode :free} @frozen) - one (freeze/head-mode {:mode :anchored :anchors {0 12}} @frozen) - keyed (freeze/head-mode {:mode :anchored - :anchors {0 12, 40 88, 150 150}} @frozen) +(deftest a-head-trace-selects-measured-frames-without-copying-channels + (let [free (freeze/head-mode {} @frozen) + one (freeze/head-mode {:trace {:origin :keys :frames [12]}} @frozen) + keyed (freeze/head-mode {:trace {:origin :keys :frames [12 88 150]}} @frozen) of (fn [c path] (get-in (nodes c) [:head :channels path]))] (doseq [c [free one keyed] path [[:xform :pos] [:xform :rot] [:xform :scale]]] (is (= :dense (ch/describe (of c path)))) - (is (= (of free path) (of c path)) "anchor edits do not copy measurements")) - (is (nil? (get-in (nodes free) [:head :anchors]))) - (is (= {0 12} (get-in (nodes one) [:head :anchors]))) - (is (= {0 12, 40 88, 150 150} - (get-in (nodes keyed) [:head :anchors]))) + (is (= (of free path) (of c path)) "a trace does not copy measurements")) + (is (nil? (get-in (nodes free) [:head :trace]))) + (is (= {:frames [12] :origin :keys} (get-in (nodes one) [:head :trace]))) (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 - (let [free (symbol/resolver (face-symbol - (freeze/head-mode {:mode :free} @frozen)) - @store pal/index-of) +(deftest trace-keys-hold-the-whole-measured-transform + (let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen)) + @store pal/index-of) held (symbol/resolver (face-symbol - (freeze/head-mode {:mode :anchored - :anchors {0 12, 40 88}} @frozen)) - @store pal/index-of) + (freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen)) + @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] (resolver frame) (vec (array-seq (symbol/world-of resolver :head))))] - (is (= (world free 12) (world held 0))) - (is (= (world free 12) (world held 38))) - (is (= (world free 88) (world held 40))) - (is (= (world free 88) (world held 100))))) + (is (= (world free 12) (world held 0)) "before the first key, the first holds") + (is (= (world free 12) (world held 87))) + (is (= (world free 88) (world held 88)) "a jump, not a tween") + (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 ;; It has to be impossible for the toggle to move something a hand placed, and ;; it has to be a DOCUMENT edit: tier 1, undoable, syncable, instant, and not a ;; reason to re-analyse. - (let [a (freeze/head-mode {:mode :free} @frozen) - b (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen) - c (freeze/head-mode {:mode :anchored :anchors {0 0, 40 40}} @frozen)] + (let [a (freeze/head-mode {} @frozen) + b (freeze/head-mode {:trace {:origin :start}} @frozen) + c (freeze/head-mode {:trace {:origin :keys :frames [0 40]}} @frozen)] (doseq [x [b c]] (is (= (get (nodes a) :face) (get (nodes x) :face)) ":face moved") @@ -287,14 +285,17 @@ ;; channels, so the clip's own fields and its other timelines are untouched. (is (= (dissoc a :symbols) (dissoc x :symbols)))))) -(deftest invalid-head-anchor-maps-are-refused - (is (thrown-with-msg? ExceptionInfo #"free or anchored" - (freeze/head-mode {:mode :stabilised} @frozen))) - (doseq [anchors [nil {} {12 12} {0 take/frames} {0 0, 10 -1}]] - (is (thrown-with-msg? ExceptionInfo #"frame-zero key" - (freeze/head-mode {:mode :anchored :anchors anchors} @frozen)))) - (is (thrown-with-msg? ExceptionInfo #"has no anchors" - (freeze/head-mode {:mode :free :anchors {0 0}} @frozen)))) +(deftest invalid-head-traces-are-refused + (doseq [t [{} {:origin :stabilised} {:origin :keys :frames [take/frames]} + {:origin :keys :frames [-1]} {:origin :keys :frames [12 4]} + {:origin :keys :frames [4 4]} {:origin :keys :frames '(4)}]] + (is (thrown-with-msg? ExceptionInfo #"trace is not one this take can hold" + (freeze/head-mode {:trace t} @frozen)) + (pr-str t))) + (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 @@ -598,7 +599,7 @@ ;; from different beats are genuinely different mouths and frames inside one ;; beat are not. This is the numeric half of step 5's done-criterion; the other ;; half is a picture and lives in test/browser/take.mjs. - (let [locked (freeze/head-mode {:mode :anchored :anchors {0 0}} @frozen) + (let [locked (freeze/head-mode {:trace {:origin :start}} @frozen) shot (fn [f] (let [r (raster/make W H) mouth (filter #(= [:face-1 :mouth] (:node %)) @@ -616,6 +617,6 @@ (is (< (differ (shot 10) (shot 12)) 200) "a held pose is moving more than the detector noise it should have lost")) ;; As filmed, the head carries it around the stage as well. - (let [filmed (freeze/head-mode {:mode :free} @frozen)] + (let [filmed (freeze/head-mode {} @frozen)] (is (> (count (remove true? (map = (render filmed 10) (render filmed 120)))) 300) "the head does not move across the take"))) diff --git a/frontend/test/arthur/flow/multi_face_test.cljs b/frontend/test/arthur/flow/multi_face_test.cljs index 3902b12..e545aeb 100644 --- a/frontend/test/arthur/flow/multi_face_test.cljs +++ b/frontend/test/arthur/flow/multi_face_test.cljs @@ -20,7 +20,7 @@ (def frames 40) (def settings (merge take/knobs {:name "two faces" :fps 30 :aspect 1 :stage [320 200] - :fit-motion? true :expose 1 :head :anchored :anchors {0 0} + :fit-motion? true :expose 1 :trace {:origin :start} :analysis (address/analysis {:detector "synth" :version "two-faces-v1" :seed 9 :frames frames :fps 30 :aspect 1})})) (def inputs @@ -62,13 +62,13 @@ (assoc-in clip [:features :duplicate] (assoc (get-in clip [:features :face-2/mouth]) :id :duplicate))))))) -(deftest one-subjects-edit-and-anchor-do-not-change-its-neighbor +(deftest one-subjects-edit-and-trace-do-not-change-its-neighbor (let [before @initial at [:clip :symbols :face-2 :nodes :iris-r :channels [:style :color]] before (assoc-in before at (ch/framed :brow)) after (regenerate/change before {:scope :feature :id :face-2/eye-r :knob :gaze-gain :value 2}) - anchored (freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 12}} after)] + 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 [:clip :symbols :face-1]) (get-in after [:clip :symbols :face-1]) @@ -77,7 +77,7 @@ (channel after :face-2 :iris-r [:xform :pos]))) (is (= (channel before :face-2 :iris-l [:xform :pos]) (channel after :face-2 :iris-l [:xform :pos]))) - (is (= {0 12} (get-in anchored [: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))))) (deftest the-second-subject-regenerates-inside-a-composed-stage @@ -92,9 +92,9 @@ (get-in after [:clip :symbols sid])))) (is (empty? (clip/problems (:clip after)))) (is (thrown? ExceptionInfo - (freeze/head-mode {:subject :face-2 :mode :anchored :anchors {0 frames}} + (freeze/head-mode {:subject :face-2 :trace {:origin :keys :frames [frames]}} 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 (let [{:keys [clip store]} @initial @@ -114,7 +114,7 @@ (assoc-in [:face-2 :presence :eye-r] (assoc (vec (repeat frames true)) 12 false))) {:keys [clip store]} (take/build settings inputs) - clip (freeze/head-mode {:mode :free} {:clip clip}) + clip (freeze/head-mode {} {:clip clip}) at8 (by-node clip store 8) at12 (by-node clip store 12)] (is (some? (get at8 [:face-1 :mouth]))) diff --git a/static/arthur/app.css b/static/arthur/app.css index c3114e6..7c018d5 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -502,6 +502,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .stage { display: block; background: var(--stage); } .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 circle { cursor: grab; } @@ -615,6 +617,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .tl-track { position: relative; } .tl-label { + /* Scrolled to from the stage: clear of the sticky ruler above. */ + scroll-margin-top: var(--ruler); display: flex; align-items: center; gap: 3px; @@ -680,6 +684,16 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } 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 frame of a span is not half-hidden by its own bar. */ .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.keyed { color: var(--fg); } .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; }