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

Compare commits

base: noe:551d57234763725bfb6f48ed0bf2b6bccfe3ed23
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes
..
compare: noe:0d49db793b8773816eded485759619a917455c42
Branches Tags
noe:master
noe:port/cljs-scaffold
noe:eyes

No commits in common. "551d57234763725bfb6f48ed0bf2b6bccfe3ed23" and "0d49db793b8773816eded485759619a917455c42" have entirely different histories.
551d572347 ... 0d49db793b

21 changed files with 162 additions and 1099 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2,19 +2,14 @@
"Render independently placed audio tracks into one stage audio clock.
The mix is derived from saved audio track leaves and immutable footage blobs.
The transport still has ONE clock, so seeking, rate changes and looping stay
tied to the same position the picture is drawn from.
The transport still has one audio element, so seeking, rate changes and looping
stay tied to the same clock the picture reads.
THE AUDIO BUFFER IS THE PRODUCT AND THE WAV IS ONE PACKAGING OF IT. `buffer!`
renders and the wrappers below it package, rather than the render being spelled
once per consumer.
PLAYBACK NO LONGER PACKAGES AT ALL. It takes the buffer as it is — see
`clock-source!` and `arthur.clock.graph` — because encoding a WAV so an
`<audio>` element had a URL to hold cost O(the clip's length) on the main
thread, on open, on every tab switch and on every edit to a track. The WAV is
now what an EXPORT wants: bytes for an archive, or the buffer itself for a
muxer. `clock!` below is the element backend's packaging and goes when it does."
THE AUDIO BUFFER IS THE PRODUCT AND THE WAV IS ONE PACKAGING OF IT. Playback
wants a URL an `<audio>` element can hold; an export wants the samples, either
as WAV bytes to put in an archive or as the `AudioBuffer` a muxer takes as an
audio track. So `buffer!` renders and the two wrappers below it package, rather
than the render being spelled once per consumer."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
@ -34,22 +29,9 @@
bytes (js/ArrayBuffer. (+ 44 (* frames channels 2)))
view (js/DataView. bytes)
samples (mapv #(.getChannelData buffer %) (range channels))
;; A HAND-WRITTEN LOOP over the typed arrays, not `(reduce max (for ...))`.
;; The lazy sequence that read beautifully allocated one boxed double per
;; SAMPLE — ten million of them for a three-minute mix — and spent the
;; whole of a sixteen-second project open walking them and collecting
;; them. Same arithmetic, no allocation.
peak (loop [c 0 p 0]
(if (< c channels)
(recur (inc c)
(let [^js data (nth samples c)]
(loop [i 0 p p]
(if (< i frames)
(recur (inc i)
(let [a (js/Math.abs (aget data i))]
(if (> a p) a p)))
p))))
p))
peak (reduce max 0
(for [channel samples i (range frames)]
(js/Math.abs (aget channel i))))
level (if (> peak 0.98) (/ 0.98 peak) 1)]
(doseq [[offset word] [[0 "RIFF"] [8 "WAVE"] [12 "fmt "] [36 "data"]]]
(dotimes [i 4] (.setUint8 view (+ offset i) (.charCodeAt word i))))
@ -62,14 +44,11 @@
(.setUint16 view 32 (* channels 2) true)
(.setUint16 view 34 16 true)
(.setUint32 view 40 (* frames channels 2) true)
;; Channel-outer so the channel's array is looked up once rather than once
;; per frame. The byte offsets are unchanged, so the interleaving is too.
(dotimes [c channels]
(let [^js data (nth samples c)]
(dotimes [i frames]
(let [sample (* level (aget data i))]
(.setInt16 view (+ 44 (* (+ (* i channels) c) 2))
(js/Math.round (* 32767 (max -1 (min 1 sample)))) true)))))
(dotimes [i frames]
(dotimes [c channels]
(let [sample (* level (aget (get samples c) i))]
(.setInt16 view (+ 44 (* (+ (* i channels) c) 2))
(js/Math.round (* 32767 (max -1 (min 1 sample)))) true))))
(js/Uint8Array. bytes)))
(defn- wav-url [^js buffer]
@ -192,43 +171,17 @@
(.arrayBuffer response)))
(.then decode-bytes!)))
(defn clock-source!
"Promise of `{:buffer :seconds}` — the audio the transport runs its clock on
while symbol `sid` is open, and how long that clock is.
Same order of preference as the WAV packaging in `clock!` below: the symbol's
own placed tracks, mixed; the document's audio file, for the symbol the
document opens on and only that one; and otherwise NO BUFFER AT ALL and the
symbol's own length.
THE SILENT CASE IS WHY THE DURATION IS RETURNED BESIDE THE BUFFER rather than
read off it. A symbol with no sound still needs a clock exactly as long as it
is, and `clock!` had to synthesize that silence and then ENCODE it, full
length, so an element had a duration to report. There is nothing to decode for
a symbol with no sound: saying how long it is answers the only question the
silence was ever asked."
(defn mix!
"Promise of a mixed WAV URL for symbol `sid`, or the original URL when it has
no audio tracks. Each track can be trimmed and faded independently of its
linked picture."
[document sid fallback-url store]
(-> (buffer! document sid store)
(.then (fn [^js buffer]
(cond
buffer
{:buffer buffer :seconds (.-duration buffer)}
(and fallback-url (= sid (clip/opens-on document)))
(-> (decode! fallback-url)
(.then (fn [^js b] {:buffer b :seconds (.-duration b)})))
:else
{:buffer nil
:seconds (/ (clip/output-frames document sid) (:fps document))})))))
(.then (fn [buffer] (if buffer (wav-url buffer) fallback-url)))))
(defn clock!
"Promise of the URL the transport should play while symbol `sid` is open.
THE ELEMENT BACKEND'S PACKAGING of `clock-source!`, kept while that backend is
— see `arthur.clock`. Every cost this namespace had on open is in the two
`wav-url` calls below.
The frame is derived from the audio element and from nothing else, so every
open symbol needs a sound exactly as long as it is. In order: its own placed
tracks, mixed; the document's audio file, for the symbol the document opens on

115
frontend/src/arthur/clock.cljs
View file

@ -3,7 +3,7 @@
THE FRAME IS DERIVED FROM THE AUDIO, never counted:
frame = ⌊position · fps⌋
frame = ⌊currentTime · fps⌋
A loop that counted frames and hoped to keep up would drift, and drift against
a voice is the one artefact that cannot be fixed downstream — a lip-sync tool
@ -12,79 +12,26 @@
The failure mode becomes a visible stutter rather than an invisible slide, and
those are very different bugs to own.
½× and ¼× are the backend's playback rate and nothing else. The audio slows,
the position advances proportionally, and the derived frame follows — so slow
motion cannot desync by construction. Implementing rate as a multiplier on a
counted frame would give the picture a rate and the sound another.
½× and ¼× are `playbackRate` and nothing else. The audio slows, `currentTime`
advances proportionally, and the derived frame follows — so slow motion cannot
desync by construction. Implementing rate as a multiplier on a counted frame
would give the picture a rate and the sound another.
It is outside app-db because the audio is the source of truth and copying it
into the db every frame would make the db a lagging mirror of something
authoritative elsewhere. What DOES belong in the db is the playhead as a piece
of document state — see events/playback — and that is written from here, not
read by here.
It is outside app-db because the audio element is the source of truth and
copying it into the db every frame would make the db a lagging mirror of
something authoritative elsewhere. What DOES belong in the db is the playhead
as a piece of document state — see events/playback — and that is written from
here, not read by here."
(:require [arthur.domain.node :as node]))
TWO BACKENDS, ONE ARITHMETIC. `position` comes from either a Web Audio graph
(`clock.graph`, the default) or an `<audio>` element (`clock.element`, kept
switchable while the first earns trust). Everything below the position — the
derivation, the clamp, the exposure grid — is here and is the same either way,
so the two can be compared on the same take rather than swapped on faith.
Build with `:closure-defines {arthur.clock/BACKEND \"element\"}`, or call
`use-backend!` from the console, to put the element back."
(:require [arthur.clock.element :as element]
[arthur.clock.graph :as graph]
[arthur.clock.transport :as t]
[arthur.domain.node :as node]))
(goog-define ^String BACKEND "graph")
(defonce ^:private mode (atom (keyword BACKEND)))
;; `{:source x :backend b}`. The source is kept so that re-attaching the same
;; thing can be recognised as the no-op it is — see `install!`.
(defonce ^:private current (atom nil))
(defn graph?
"Whether the app should wire up the graph backend. Read by `ui/shell`, which
renders the audio element only when this is false, and by `events/playback`,
which fetches a buffer rather than a WAV URL when it is true."
[]
(and (= :graph @mode) (graph/available?)))
(defn use-backend!
"Switch backends. Takes effect on the next thing that attaches one, which is
the next tab switch or document open — nothing is torn down under a take
that is already playing."
[m]
(reset! mode m))
(defn- install!
"Put a backend on `source`, unless `source` is already the clock's.
IDEMPOTENCE IS LOAD-BEARING HERE. The element's `:ref` is an inline closure,
so React hands it the same node again on every re-render of the shell —
rebuilding the clock there would mean a pane being dragged released whatever
was playing. The source is the identity: the element, or the buffer and its
length."
[source make]
(let [{:keys [backend] prev :source} @current]
(when-not (and backend (= prev source))
(when backend (t/-release! backend))
(reset! current {:source source
:backend (when (some? source) (make))}))))
(defonce ^:private el (atom nil))
(defn attach!
"Hand the clock an audio element. Idempotent. Element backend only — the
`:ref` that calls this is on a node `ui/shell` renders only in that mode."
"Hand the clock its audio element. Idempotent."
[audio-el]
(install! audio-el #(element/backend audio-el)))
(reset! el audio-el))
(defn attach-buffer!
"Hand the clock `seconds` of audio to run on, as an `AudioBuffer` or as nil
for silence of that length. Graph backend only."
[buffer seconds]
;; Keyed on the length as well as the buffer, because two silent clocks of
;; different lengths are two different clocks and both have a nil buffer.
(install! [buffer seconds] #(graph/backend buffer seconds)))
(defn element [] @el)
(defn- clamp [f frames]
(-> f (max 0) (min (dec frames))))
@ -92,52 +39,56 @@
(defn frame
"The clip frame the audio is currently on."
[fps frames]
(if-let [b (:backend @current)]
(clamp (js/Math.floor (* (t/-position b) fps)) frames)
(if-let [a @el]
(clamp (js/Math.floor (* (.-currentTime a) fps)) frames)
0))
(defn playing? []
(boolean (when-let [b (:backend @current)] (t/-playing? b))))
(boolean (when-let [a @el] (and (not (.-paused a)) (not (.-ended a))))))
(defn rate []
(if-let [b (:backend @current)] (t/-rate b) 1.0))
(if-let [a @el] (.-playbackRate a) 1.0))
(defn set-rate! [r]
(when-let [b (:backend @current)] (t/-set-rate! b r)))
(when-let [a @el] (set! (.-playbackRate a) r)))
(defn play! []
(when-let [b (:backend @current)] (t/-play! b)))
(when-let [a @el]
;; Returns a promise that rejects if the browser has not seen a gesture yet.
;; Swallowed: the transport button IS the gesture, so this can only fire on a
;; programmatic play, where a console error is noise rather than news.
(some-> (.play a) (.catch (fn [_])))))
(defn pause! []
(when-let [b (:backend @current)] (t/-pause! b)))
(when-let [a @el] (.pause a)))
(defn seek!
"Put the audio at the start of frame f. Seeking to the frame's start rather
than its middle keeps `frame` idempotent: seek to f, read back f."
[fps frames f]
(when-let [b (:backend @current)]
(t/-seek! b (/ (clamp f frames) fps))))
(when-let [a @el]
(set! (.-currentTime a) (/ (clamp f frames) fps))))
(defn set-loop!
"Wrap at the end instead of stopping. The frame stays derived — the position
"Wrap at the end instead of stopping. The frame stays derived — `currentTime`
simply returns to zero — so nothing about the sync changes, which is the point
of not counting frames.
It earns its place at 2x and 4x, where the whole clip is gone in under four
seconds and a profile wants more than that to look at."
[on?]
(when-let [b (:backend @current)] (t/-set-loop! b on?)))
(when-let [a @el] (set! (.-loop a) (boolean on?))))
(defn set-muted! [on?]
(when-let [b (:backend @current)] (t/-set-muted! b on?)))
(when-let [a @el] (set! (.-muted a) (boolean on?))))
(defn duration-frames
"How many frames the audio actually covers, which need not be the clip's
length. Reported rather than assumed: a clip longer than its audio is a
legitimate thing to be told about, not a thing to silently truncate."
[fps]
(when-let [b (:backend @current)]
(let [d (t/-duration b)]
(when-let [a @el]
(let [d (.-duration a)]
(when (and d (js/isFinite d)) (js/Math.ceil (* d fps))))))
(defn exposed-frame

45
frontend/src/arthur/clock/element.cljs
View file

@ -1,45 +0,0 @@
(ns arthur.clock.element
"The clock on an `<audio>` element. The original backend, kept switchable.
Reads `currentTime` and takes it as the position. That is the whole of it, and
it is why this backend needs a WAV: an element holds a URL, so a mixdown has
to be encoded and blobbed before it can be played — see `audio/mix`'s
`clock!`. The encode is O(the clip's length) and runs on the main thread, so a
long take costs seconds of frozen UI on open, on every tab switch and on every
edit to a track. `arthur.clock.graph` exists to not do that.
What this backend still has that the graph one has to be told: the OS media
keys and the media session, which the element gets from the browser for free.
KEPT so the two can be compared on the same document rather than swapped on
faith. When the graph backend has been trusted for a while, this namespace and
`mix/clock!`'s WAV packaging go together."
(:require [arthur.clock.transport :as t]))
(deftype Element [^js el]
t/Transport
(-position [_] (.-currentTime el))
(-duration [_] (.-duration el))
(-playing? [_] (and (not (.-paused el)) (not (.-ended el))))
(-rate [_] (.-playbackRate el))
(-set-rate! [_ r] (set! (.-playbackRate el) r))
(-play! [_]
;; Returns a promise that rejects if the browser has not seen a gesture yet.
;; Swallowed: the transport button IS the gesture, so this can only fire on a
;; programmatic play, where a console error is noise rather than news.
(some-> (.play el) (.catch (fn [_]))))
(-pause! [_] (.pause el))
(-seek! [_ seconds] (set! (.-currentTime el) seconds))
(-set-loop! [_ on?] (set! (.-loop el) (boolean on?)))
(-set-muted! [_ on?] (set! (.-muted el) (boolean on?)))
(-release! [_]
;; Nothing. React owns the element and unmounting it is what stops it; this
;; backend is a few property accesses wrapped in a type and holds no more
;; than that.
nil))
(defn backend
"Wrap an audio element — or anything that answers the same five properties,
which is what `clock-test`'s fake is."
[el]
(->Element el))

266
frontend/src/arthur/clock/graph.cljs
View file

@ -1,266 +0,0 @@
(ns arthur.clock.graph
"The clock on a Web Audio graph. No encode, no blob, no element.
THE BUFFER IS PLAYED, NOT PACKAGED. `audio/mix`'s `buffer!` already renders
the mixdown; the element backend then spent O(the clip's length) encoding that
buffer to a WAV purely so a `src` attribute had something to point at. An
`AudioBufferSourceNode` takes the buffer as it is, so opening a document costs
one node instead of a hundred megabytes of 16-bit PCM.
THE FRAME IS STILL DERIVED, AND FROM A BETTER CLOCK. `AudioContext.currentTime`
is the audio device's own position in double precision, advancing every 128
samples; an element's `currentTime` is whatever the media pipeline last
published and is permitted to lag. Nothing is counted here either — position is
an anchor plus elapsed context time, and the anchor is re-set on every seek and
every rate change, so no arithmetic accumulates across either.
AND IT IS LATENCY-COMPENSATED, which is the one thing this backend must get
right. `currentTime` is the time of the quantum being RENDERED, which the
speaker is `outputLatency` behind — tens of milliseconds, far more over
Bluetooth. Report the renderer's position and the picture leads the sound by
exactly that much, which in a lip-sync tool is the only artefact that matters.
So `scheduled` is the bookkeeping and `-position` is `scheduled` read one
latency in the past. The element has the same lag underneath; the difference is
that this one is a number we can subtract rather than an error we inherit.
A SYMBOL WITH NO SOUND GETS A CLOCK ANYWAY, with no buffer at all: `seconds`
is its length and the context's clock does the rest. The element backend had to
synthesize silence and encode THAT to a WAV, full length, so the element had a
duration to report — the clearest sign that the element was driving the design
rather than serving it."
(:require [arthur.clock.transport :as t]))
(defonce ^:private shared (atom nil))
(defn available?
"Whether this backend can run at all. False under node, where the tests live."
[]
(exists? js/AudioContext))
(defn context
"The app's one `AudioContext`, made on first use.
Lazy because constructing one before anything wants to play is how a browser
decides the page is trying to autoplay, and because `available?` is false in
the test runner."
[]
(or (:ctx @shared)
(let [ctx (js/AudioContext.)
;; ONE output gain for the app, not one per backend: a tab switch
;; replaces the backend, and a gain node per backend would leave the
;; old one wired to the destination. Mute lives here for the same
;; reason — it is a property of the transport, not of whichever
;; buffer happens to be loaded.
out (.createGain ctx)]
(.connect out (.-destination ctx))
(:ctx (reset! shared {:ctx ctx :out out})))))
(defn output [] (do (context) (:out @shared)))
(defn- latency
"How far ahead of the speaker `currentTime` is, in seconds.
`outputLatency` is the whole path and the number we want. Firefox reports 0
until the graph has actually run, so `baseLatency` stands in — it is only the
graph's own buffering and therefore an underestimate, which errs towards the
picture leading slightly rather than the correction overshooting. Neither
exists everywhere; 0 is then no worse than the element."
[^js ctx]
(let [out (.-outputLatency ctx)
base (.-baseLatency ctx)]
(cond
(and (number? out) (js/isFinite out) (pos? out)) out
(and (number? base) (js/isFinite base) (pos? base)) base
:else 0)))
(defn- seg-at
"The segment governing context time `t`."
[segs t]
(or (last (filter #(<= (:from %) t) segs)) (first segs)))
(defn- raw
"Where the audio is at context time `t`, in seconds into the buffer.
PIECEWISE, and that is the whole subtlety of this namespace. Audio already
rendered cannot be re-rated: when the transport goes 1x -> 4x, the samples
still travelling to the speaker were rendered at 1x, so reading them back at
4x jumps the playhead BACKWARDS by three output latencies — about fourteen
frames on a laptop, which is a visible lurch on every rate change and was
exactly what the first version of this did. So each `play`, `pause`, `seek`
and rate change records a segment, and a position is read against whichever
segment was in force when that audio was rendered.
Evaluated before the oldest segment we kept, it clamps. That is what makes a
seek read back exactly what was seeked to: a seek has nothing in flight worth
honouring — the user has jumped — so its segment starts the timeline over."
[segs t]
(let [t (max t (:from (first segs)))
s (seg-at segs t)]
(+ (:anchor s) (* (:rate s) (- t (:from s))))))
(defn- at-renderer
"Where the graph has rendered up to: `raw` at the context's own clock."
[{:keys [^js ctx segs]}]
(raw segs (.-currentTime ctx)))
(defn- at-speaker
"Where the sound being heard is: `raw` one output latency in the past. See the
namespace docstring — this is the whole of the compensation."
[{:keys [^js ctx segs]}]
(raw segs (- (.-currentTime ctx) (latency ctx))))
(defn- running?
"Whether the renderer is advancing. Read off the segments rather than kept
beside them, so there is one answer and not two that can disagree."
[{:keys [segs]}]
(pos? (:rate (last segs))))
(defn- prune
"Drop segments no position can still need: everything before the last one that
began at or before the in-flight window. Unbounded history would otherwise
grow by one entry per rate change for the life of the document."
[segs cutoff]
(let [n (count (take-while #(<= (:from %) cutoff) segs))]
(if (<= n 1) segs (subvec segs (dec n)))))
(defn- position
"`at-speaker`, brought inside the audio. Clamped before the wrap, so the few
milliseconds of negative position right after a looped play — the first
samples are still in the output buffer — read as 0 rather than as the end."
[{:keys [seconds loop?] :as st}]
(let [p (at-speaker st)]
(cond
(not (and seconds (pos? seconds))) 0
loop? (mod (max 0 p) seconds)
:else (-> p (max 0) (min seconds)))))
(defn- done?
"Run off the end. Judged at the SPEAKER, so playback is still reported as
running while the last scheduled samples are on their way out."
[{:keys [seconds loop?] :as st}]
(and (not loop?) seconds (pos? seconds) (>= (at-speaker st) seconds)))
(defn- spin-up!
"A fresh source node playing from where the renderer now is.
`AudioBufferSourceNode`s are single-use, so a play, a seek while playing and a
resumed pause each make a new one; they are cheap, which is the point of this
backend.
Nil when there is no buffer — the silent clock runs on the context alone."
[{:keys [^js ctx ^js buffer ^js out rate loop? seconds] :as st}]
(when buffer
(let [node (.createBufferSource ctx)]
(set! (.-buffer node) buffer)
(set! (.-loop node) (boolean loop?))
(set! (.-value (.-playbackRate node)) rate)
(.connect node out)
;; `when` 0 is "as soon as the graph can"; the offset is where in the
;; buffer to begin. Clamped because starting past the end is a range
;; error rather than a no-op in some engines.
(.start node 0 (-> (at-renderer st) (max 0) (min (or seconds 0))))
node)))
(defn- spin-down! [{:keys [^js node]}]
(when node
(try (.stop node) (catch :default _ nil))
(try (.disconnect node) (catch :default _ nil))))
(defn- restart!
"Begin a new timeline at `anchor`, running at `rate` or held when it is 0.
A RESET rather than a segment, for the three cases that have nothing in flight
worth honouring: a play starts fresh, a seek means the user has jumped, and a
pause wants one stable number for the readout rather than a position that
creeps forward as the output buffer drains."
[state anchor rate]
(let [st @state]
(spin-down! st)
(swap! state assoc
:segs [{:from (.-currentTime ^js (:ctx st)) :anchor anchor :rate rate}]
:node nil)
(when (pos? rate)
(swap! state assoc :node (spin-up! @state)))))
(deftype Graph [state]
t/Transport
(-position [_] (position @state))
(-duration [_] (:seconds @state))
(-playing? [_] (let [st @state] (boolean (and (running? st) (not (done? st))))))
(-rate [_] (:rate @state))
(-set-rate! [_ r]
;; A SEGMENT, not a reset — the one case where what is already in flight has
;; to keep its old rate or the playhead lurches. See `raw`.
(let [st @state
now (.-currentTime ^js (:ctx st))]
(if (running? st)
(let [anchor (at-renderer st)]
(swap! state #(-> %
(assoc :rate r)
(update :segs (fn [segs]
(prune (conj segs {:from now :anchor anchor :rate r})
(- now (latency ^js (:ctx st))))))))
(when-let [^js node (:node st)]
(set! (.-value (.-playbackRate node)) r)))
;; Stopped: nothing is in flight and nothing is rendering, so the rate
;; is simply what the next play will run at.
(swap! state assoc :rate r))))
(-play! [_]
(let [st @state]
;; `done?` counts as not playing. It is DERIVED — no flag is cleared when
;; the take runs off its end — so testing "running" alone would make play
;; a dead button from the moment the audio finished.
(when (or (not (running? st)) (done? st))
;; The context starts suspended and only a gesture may resume it. The
;; transport button IS the gesture, so a rejection here means a
;; programmatic play and is noise rather than news — as on the element.
(some-> (.resume ^js (:ctx st)) (.catch (fn [_])))
;; Play at the end starts over, which is what the element does.
(restart! state (if (done? st) 0 (position st)) (:rate st)))))
(-pause! [_]
(let [st @state]
(when (running? st)
;; Anchored at what was HEARD, not at what was scheduled, so play after
;; pause resumes from where the sound stopped. It re-plays the last few
;; milliseconds rather than skipping them, which is the kinder of the
;; two roundings.
(restart! state (position st) 0))))
(-seek! [_ seconds]
(restart! state seconds (if (running? @state) (:rate @state) 0)))
(-set-loop! [_ on?]
(swap! state assoc :loop? (boolean on?))
;; The audio thread reads `loop` every quantum, so a live node picks this up
;; without being restarted — the same as setting `loop` on a playing element.
(when-let [^js node (:node @state)]
(set! (.-loop node) (boolean on?))))
(-set-muted! [_ on?]
(set! (.-value (.-gain ^js (:out @state))) (if on? 0 1)))
(-release! [_]
;; The source node is wired to the output the whole app shares, so a backend
;; dropped while playing would go on being heard under the one that replaced
;; it. Nothing else here needs releasing: the context and its gain outlive
;; every backend by design.
(let [st @state]
(spin-down! st)
(swap! state assoc
:segs [{:from (.-currentTime ^js (:ctx st))
:anchor (position st) :rate 0}]
:node nil))))
(defn backend
"A clock on `buffer`, `seconds` long. A nil buffer is a silent clock of that
length — see the namespace docstring.
The context and output are injected by the four-argument form so the whole of
this is assertable against a fake in node, where there is no Web Audio."
([buffer seconds] (backend (context) (output) buffer seconds))
([^js ctx ^js out buffer seconds]
(->Graph (atom {:ctx ctx :out out :buffer buffer :seconds seconds
:rate 1.0 :loop? false :node nil
:segs [{:from (.-currentTime ctx) :anchor 0 :rate 0}]}))))

38
frontend/src/arthur/clock/transport.cljs
View file

@ -1,38 +0,0 @@
(ns arthur.clock.transport
"What the clock needs of a thing that plays sound, and nothing more.
`arthur.clock` does the arithmetic — the frame derivation, the clamping, the
exposure grid — and a backend only has to answer where the sound has got to
and do as it is told. Keeping the protocol this thin is what makes the two
implementations comparable: if the graph backend and the element backend
disagree about a take's sync, the difference is in these nine methods and not
in anything derived from them.
POSITION IS WHERE THE SPEAKER IS, not where the renderer is. A backend that
schedules audio ahead of the output owes the difference back here — see
`arthur.clock.graph` — because the picture is drawn against this number and a
lip-sync tool that draws against the scheduler leads the sound it is matching.")
(defprotocol Transport
(-position [this]
"Seconds into the audio, as heard. Never negative, never past `-duration`,
and wrapped rather than clamped while looping.")
(-duration [this]
"Seconds of audio, or nil when the backend has not been told yet.")
(-playing? [this]
"Running AND not finished. A backend that has reached its end reports false
even if nothing told it to stop, because the end of the sound is the
authority on playback having stopped — see `ui/player`'s loop.")
(-rate [this])
(-set-rate! [this r])
(-play! [this])
(-pause! [this])
(-seek! [this seconds]
"Put the audio at `seconds`. Reading `-position` back must give the same
number, which is what makes a scrub idempotent.")
(-set-loop! [this on?])
(-set-muted! [this on?])
(-release! [this]
"Give up whatever this backend holds, because something else is about to be
the clock. NOT a pause: a backend that owns nothing has nothing to do here,
and the position it was last at is no longer anybody's business."))

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

@ -64,31 +64,6 @@
[clip sid]
(or (:name (symbol clip sid)) (name sid)))
(defn node-label
"What to call node `n` on screen.
A NAME A PERSON TYPED WINS, and for an instance that is the ONLY thing `:name`
now means: `place-symbol` deliberately does not copy the symbol's name onto the
node it makes. Two instances of one symbol are told apart by what somebody
called them — `8625 left` and `8625 right` of one `face` — and reading through
in front of that would collapse them to the same word.
OTHERWISE AN INSTANCE IS LABELLED BY WHAT IT PLACES, read through on every
render. A name copied at creation goes stale the moment the symbol is renamed,
and then the document shows one thing under two names: the symbol reads `bg` in
its tab while an instance of it still reads `symbol-18`, which is how a person
comes to paste a symbol into itself without being able to see that is what they
are doing. `problems` refuses that cycle; this is why it stops looking like a
reasonable thing to try.
An id is a uuid for a placement and a keyword for an authored node, and neither
reads as a name, so the last resort is a legible stand-in rather than `(str
id)` — `:face-1` keeps its colon and a uuid pushes a column open."
[clip id n]
(or (:name n)
(some->> (node/source n) (symbol-name clip))
(if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))
(defn frames
"A symbol's length. Read off the symbol, never copied beside it."
[clip sid]
@ -520,6 +495,7 @@
(update-symbol
clip host assoc-in [:nodes uuid]
{:id uuid
:name (symbol-name clip sid)
:kind :instance
:parent nil
;; Lexicographic draw order, as `domain/paint` does it: an instance made
@ -639,23 +615,6 @@
missing (remove (:symbols clip) (node/sources n))]
(str "symbol " (pr-str sid) " instance " (pr-str id)
" names missing symbol " (pr-str missing)))
;; THE INVARIANT `place-symbol` AND `ui/drag` ALREADY ENFORCE, stated here so
;; that every command is checked against it rather than the two that remember
;; to ask. A symbol placed inside itself, or inside anything it places, has no
;; finite expansion: `build` above and `nest/audio-tracks` both walk instances
;; and both throw on the way round. Paste reached this function without it and
;; wrote a document that saved, loaded, and only then threw — which is the one
;; outcome `problems` exists to make impossible.
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)
:when (= :instance (:kind n))
src (node/sources n)
;; A source that does not exist is the rule above's to report, not this
;; one's, so it does not get named twice.
:when (and (contains? (:symbols clip) src)
(contains-symbol? clip src sid))]
(str "symbol " (pr-str sid) " instance " (pr-str id) " places "
(pr-str src) (if (= src sid) ", which is itself" ", which contains it")))
;; Pose tracks belong to this cel's single source symbol.
(for [[sid sym] (:symbols clip)
[id n] (:nodes sym)

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

@ -10,8 +10,7 @@
WHAT GOES IN THE DB IS THE REQUEST AND THE PROGRESS, never the frames. A
megabyte of PNG in app-db would be compared by every mounted subscription on
every tick."
(:require [arthur.domain.clip :as clip]
[arthur.domain.palette :as pal]
(:require [arthur.domain.palette :as pal]
[arthur.export :as export]
[arthur.export.frames :as frames]
[arthur.footage.store :as store]
@ -78,17 +77,17 @@
the other instances removed, which is why seven instances of one symbol are
seven different exports rather than seven copies of one.
Instances are ordered and labelled by `clip/node-label`, never by id: a uuid
sorts at random and means nothing to read."
Instances are ordered and labelled by `:name`, never by id: a uuid sorts at
random and means nothing to read."
[clip open]
(let [label #(clip/node-label clip %1 %2)
instances (->> (get-in clip [:symbols open :nodes])
(let [instances (->> (get-in clip [:symbols open :nodes])
(filter (comp #{:instance} :kind val))
(sort-by (fn [[id n]] [(label id n) (str id)])))]
(sort-by (fn [[id n]] [(or (:name n) "") (str id)])))]
(into (mapv (fn [sid] {:symbol sid :label (name sid)})
(sort-by str (keys (:symbols clip))))
(mapv (fn [[id n]]
{:symbol open :isolate id :label (label id n)})
{:symbol open :isolate id
:label (or (:name n) (str id))})
instances))))
(defn target

51
frontend/src/arthur/events/playback.cljs
View file

@ -139,8 +139,7 @@
:status "built-in example · not a saved project"}))]
{:db db
::pause! nil
::seek! [(fps db) (frames db) 0]
::clock! {:id id :sid (get-in db [:ui :open])}})))
::seek! [(fps db) (frames db) 0]})))
;; ---------------------------------------------------------------------------
;; tabs
@ -154,48 +153,26 @@
(rf/reg-fx
::clock!
;; WHAT THE OPEN SYMBOL SOUNDS LIKE, fetched once per thing that can change it:
;; a document opening, a tab switch, an edit to a track. The graph backend is
;; handed the buffer; the element backend needs a URL, which means a WAV, which
;; is the whole of what this used to cost.
(fn [{:keys [id sid]}]
(let [{:keys [clip audio store]} (footage/entry id)]
(-> (if (clock/graph?)
(mix/clock-source! clip sid audio store)
(.then (mix/clock! clip sid audio store) (fn [u] {:url u})))
(-> (mix/clock! clip sid audio store)
(.then #(rf/dispatch [::clock-ready id sid %]))
(.catch #(js/console.error %))))))
(rf/reg-event-fx
::clock-ready
(fn [{:keys [db]} [_ id sid {:keys [url buffer seconds]}]]
(if-not (and (= id (:clip/current db)) (= sid (get-in db [:ui :open])))
{}
(if (clock/graph?)
(do
(clock/attach-buffer! buffer seconds)
;; RATE, LOOP AND MUTE ARE RE-APPLIED. They are transport state and
;; outlive the clock they were set on, but a fresh graph starts at its
;; defaults — so without this a tab switch would quietly drop the take
;; back to 1x, unlooped and unmuted. The element kept them because they
;; were properties of a node that survived its own `src` changing.
{:fx [[::rate! (get-in db [:playback :rate] 1.0)]
[::loop! (boolean (get-in db [:playback :loop?]))]
[::mute! (boolean (get-in db [:playback :muted?]))]
[::seek! [(fps db) (frames db) (get-in db [:playback :frame] 0)]]
;; An edit under a playing take resumes it. The element stopped
;; dead here, which made adjusting a fade while listening to it
;; a thing you could only do once.
(when (get-in db [:playback :playing?]) [::play! nil])]})
(do
;; A blob URL made for the last tab is released when the next one lands,
;; and never the document's own file.
(when-let [old @clock-url]
(when (not= old url) (js/URL.revokeObjectURL old)))
(reset! clock-url (when (and (not= url (:audio (footage/entry id)))
(.startsWith url "blob:"))
url))
{:db (assoc-in db [:clip :audio] url)})))))
(fn [{:keys [db]} [_ id sid url]]
(if (and (= id (:clip/current db)) (= sid (get-in db [:ui :open])))
(do
;; A blob URL made for the last tab is released when the next one lands,
;; and never the document's own file.
(when-let [old @clock-url]
(when (not= old url) (js/URL.revokeObjectURL old)))
(reset! clock-url (when (and (not= url (:audio (footage/entry id)))
(.startsWith url "blob:"))
url))
{:db (assoc-in db [:clip :audio] url)})
{})))
(rf/reg-event-db
::paint-failed

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

@ -30,6 +30,7 @@
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.events.edit :as edit]
[arthur.audio.mix :as mix]
[arthur.demo.stage :as stage]
[arthur.domain.feature :as feature]
[arthur.domain.project :as project]
@ -123,15 +124,9 @@
;; write lands on what does not.
:synced (project/tier1 (.-leaves clip-json))
:clip built :store (:store loaded)
;; The document's OWN file, unmixed. What
;; the symbol actually sounds like is the
;; clock's business and is fetched once,
;; by `::pb/clock!`, when it goes on
;; screen — this used to mix it here as
;; well, and the two encodes of the same
;; audio were most of a project open.
:audio "/static/arthur/audio.wav"})]
entry))))))
(-> (mix/mix! built (clip/opens-on built) (:audio entry) (:store entry))
(.then (fn [audio] (assoc entry :audio audio))))))))))
(defn- saved-clip!
"Promise of clip `cid` of saved project `pid`, as `{:clip :store}`: its
@ -416,7 +411,11 @@
entry (assoc entry :clip built :label (:name built)
:cid "stage-8625"
:width (:width built) :height (:height built))]
(rf/dispatch [::stage-opened (store/install! entry "stage")]))))
(-> (mix/mix! built (clip/opens-on built) (:audio entry) (:store entry))
(.then (fn [audio]
(rf/dispatch
[::stage-opened
(store/install! (assoc entry :audio audio) "stage")])))))))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
@ -558,13 +557,12 @@
;; events
(def blank-audio
"The audio a new document opens on, until it gets one of its own.
"A new document still needs a clock.
It is no longer load-bearing. The frame is derived from a position, and the
graph backend can hold one for a symbol with no sound at all — see
`mix/clock-source!` — so a silent stage has time and `play` works. This stays
because a new document borrowing the synthetic take's soundtrack is a
convenience worth keeping, not because the clock would stop without it."
The frame is derived from an audio element and from nothing else — see
`arthur.clock` — so a stage with no sound has no time and `play` is a button
that cannot work. The synthetic take borrows this same asset for exactly this
reason. When a document gets audio of its own, it replaces this."
"/static/arthur/audio.wav")
(defn blank-entry
@ -593,8 +591,7 @@
;; The readout goes home with the document; so must the clock, or play
;; picks up wherever the last document's audio had got to.
::pb/seek! [(:fps entry) (clip/output-frames (:clip entry) (clip/opens-on (:clip entry))) 0]
::pb/pause! nil
::pb/clock! {:id id :sid (clip/opens-on (:clip entry))}})))
::pb/pause! nil})))
(rf/reg-event-fx
::save
@ -706,24 +703,6 @@
(-> (edit/edit db #(assoc-in % [:palettes id] p))
(assoc-in [:ui :palette] id)))))
(rf/reg-event-db
::duplicate-palette
;; A copy of an existing palette, selected so the next colour edit lands on the
;; copy rather than the original. The point is a variant: start from a palette
;; that works and change two tones, instead of 16 colour pickers from black.
;; `pal/palettes` is the source so the implicit default - a project that has
;; never had a palette asset of its own - can be duplicated like any other.
(fn [db [_ id]]
(let [clip (:clip (store/entry (:clip/current db)))
p (get (pal/palettes clip) id)]
(if-not p
db
(let [new-id (random-uuid)]
(-> (edit/edit db #(assoc-in % [:palettes new-id]
(assoc p :id new-id
:name (str (:name p) " copy"))))
(assoc-in [:ui :palette] new-id)))))))
(rf/reg-event-db
::palette-name
(fn [db [_ id value]]
@ -851,8 +830,7 @@
(assoc :project {:id nil :cid nil :name nil :seq nil
:busy? false :status "loaded 8625 stage study"}))]
{:db db
::pb/seek! [(get-in db [:clip :fps]) (pb/frames db) 0]
::pb/clock! {:id clip-id :sid (get-in db [:ui :open])}})))
::pb/seek! [(get-in db [:clip :fps]) (pb/frames db) 0]})))
(rf/reg-event-fx
::saved
@ -902,9 +880,7 @@
:status (str "opened " name " r" seq)}))
::pb/pause! nil
::pb/seek! (let [{c :clip fps :fps} (store/entry clip-id)]
[fps (clip/output-frames c (clip/opens-on c)) 0])
::pb/clock! {:id clip-id
:sid (clip/opens-on (:clip (store/entry clip-id)))}}))
[fps (clip/output-frames c (clip/opens-on c)) 0])}))
(rf/reg-event-fx
::failed

68
frontend/src/arthur/events/ui.cljs
View file

@ -760,13 +760,8 @@
(nil? target) []
(= :instance (get-in document [:symbols sid :nodes id :kind])) path0
:else (vec (butlast path0)))
;; A ROW WITH NO PATH IS THE SYMBOL IT NAMES, on this very frame: the
;; open symbol's own row, and a palette track's, which hangs off its
;; owner by `:palette-track` instead of being placed in it and so is
;; reached by naming it rather than by walking to it.
from (if (seq path) open (or sid open))
{destination :sid at :frame matrix :matrix}
(nest/inside document st from path frame)]
(nest/inside document st open path frame)]
(cond
(nil? destination) {:refused "what you are dropping into is not on screen at this frame"}
(not (integer? at)) {:refused "the drop is not on one frame of that symbol"}
@ -807,45 +802,34 @@
(edit/transaction (constantly (:clip result)))
(selected [:node sid uuid (conj (vec path) uuid)]))))
(defn- lane-of-palette-row
"`document` and `target` with the palette row of a symbol that has no palette
track yet replaced by that track, created here.
THE ONE ROW THAT MAY NAME A LANE THAT DOES NOT EXIST, and the only thing
anything downstream needs to know about palettes: materializing it turns that
row into an ordinary lane row, so one gesture resolves and places through one
rule. The track borrows its owner's clock because it is read frame for frame
against it."
[document target]
(if-let [owner (when (= :arthur.ui.timeline/palette-track (first target))
(second target))]
(let [track (or (get-in document [:symbols owner :palette-track])
(clip/fresh-id document))]
[(-> document
(assoc-in [:symbols owner :palette-track] track)
;; What is there already wins, so this fills a track in and can never
;; empty one.
(update-in [:symbols track]
#(merge {:id track :name "palette" :type :palette-track
:display :lane :frames (clip/frames document owner)
:fps (clip/fps document owner) :nodes {}}
%)))
[:node track nil []]])
[document target]))
(rf/reg-event-db
::new-symbol-at
;; ONE GESTURE AND ONE CREATION PATH FOR EVERY LANE. Empty space in a lane
;; takes a new one-frame symbol at the frame double-clicked -- the pointer
;; names a place in time as well as a lane, which is the whole of the gesture
;; and the reason it is not the playhead's. The DESTINATION decides what is
;; created there: a clip of a palette track is a palette symbol whose
;; placement starts by inheriting, a clip of any other lane is a blank symbol.
(fn [db [_ frame target]]
;; One gesture and one creation path for every lane. The destination decides
;; the kind: an ordinary lane gets a blank symbol; the synthetic palette row
;; gets a blank palette symbol whose placement starts by inheriting.
(fn [db [_ _pointer-frame target]]
(let [{document :clip st :store} (store/entry (:clip/current db))
[document target] (lane-of-palette-row document target)
where (drop-destination db document st frame target)
palette? (= :palette-track (get-in document [:symbols (:sid where) :type]))
;; Creation always happens at the playhead. The double-click only
;; names the lane; it is not a second, pointer-based time cursor.
frame (editing-frame db document)
palette? (= :arthur.ui.timeline/palette-track (first target))
root-sid (second target)
root (when palette? (clip/symbol document root-sid))
old-track (:palette-track root)
track-id (when palette?
(if (= :palette-track (get-in document [:symbols old-track :type]))
old-track (clip/fresh-id document)))
document (if (and palette? (not= track-id old-track))
(-> document
(assoc-in [:symbols root-sid :palette-track] track-id)
(assoc-in [:symbols track-id]
{:id track-id :name "palette" :type :palette-track
:display :lane :frames (:frames root)
:fps (clip/fps document root-sid) :nodes {}}))
document)
where (if palette?
{:clip document :sid track-id :at frame :path []}
(drop-destination db document st frame target))
sid (clip/fresh-id document)
uuid (random-uuid)]
(if (:refused where)

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

@ -72,14 +72,8 @@
(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.
;;
;; THE DOCUMENT IS PART OF THE IDENTITY, not just the symbol. `ui/shell`
;; re-mixes when this changes under the SAME symbol, and two documents both
;; opening on `:main` would otherwise look like one symbol whose tracks had
;; been edited — so opening a project re-mixed it a second time, on top of
;; the mix the open itself had already asked for.
(let [c (:clip (footage/entry id))]
[id sid (when (clip/symbol c sid) (nest/audio-tracks c sid))])))
[sid (when (clip/symbol c sid) (nest/audio-tracks c sid))])))
(rf/reg-sub
::symbol

12
frontend/src/arthur/subs/ui.cljs
View file

@ -5,9 +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.creation :as creation]
[arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.pick :as pick]
[arthur.footage.store :as store]
[arthur.subs.playback :as playback]
@ -95,15 +93,7 @@
(when-let [{:keys [sid id frame] :as pl} (nest/placement clip st open path f)]
(let [n (get-in clip [:symbols sid :nodes id])]
(assoc pl :node n
;; An explicitly created symbol can be empty. It is still a
;; valid creation destination, so give its occurrence a
;; visible target box using the source symbol's stage until
;; content supplies tighter bounds. Drawing-created symbols
;; already take the normal content-bounds branch.
:bounds (or ((pick/bounds-of clip st sid n) frame)
(when-let [source (node/source n)]
(let [[w h] (clip/stage clip source)]
[0 0 w h]))))))))))
:bounds ((pick/bounds-of clip st sid n) frame))))))))
(rf/reg-sub
::selected-placement

6
frontend/src/arthur/ui/location.cljs
View file

@ -37,7 +37,11 @@
else is named as the timeline names it: `:name` when it has one, and a legible
stand-in when it has not."
[clip id n]
(clip/node-label clip id n))
(let [of (node/source n)]
(or (when of (:name (clip/symbol clip of)))
(:name n)
(when of (name of))
(if (keyword? id) (subs (str id) 1) (subs (str id) 0 8)))))
(defn trail
"The crumbs from symbol `sid` down to the end of row path `path`, the symbol

2
frontend/src/arthur/ui/palette.cljs
View file

@ -64,8 +64,6 @@
(for [[id p] (sort-by (comp str :name val) (pal/palettes clip))]
^{:key (str id)} [:option {:value (str id)} (:name p)])]
[:button {:title "new 16-slot palette" :on-click #(rf/dispatch [::project/new-palette])} "+"]
[:button {:title (str "duplicate " (:name palette) " — a copy you can retone")
:on-click #(rf/dispatch [::project/duplicate-palette pid])} "⧉"]
[:div.swatches (doall (map-indexed #(swatch pid %1 %2 tone placements) (:slots palette)))]
[:span.dim (str tone)]
(when (> (count selections) 1)

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

@ -1,6 +1,5 @@
(ns arthur.ui.shell
"The window: one grid, five panes, a location bar, and the clock's audio
element on the backend that needs one.
"The window: one grid, five panes, a location bar, and the audio element.
Nothing else. Each pane owns its own subscriptions, so this component re-renders
only when the grid itself would change — which is a pane being resized, shut or
@ -30,34 +29,21 @@
;; only a change under the same one counts.
(r/with-let [heard (atom nil)
remix (r/track! (fn []
(let [[id sid :as now] @(rf/subscribe [::render/sounds])
[was-id was-sid :as before] @heard]
(let [[sid :as now] @(rf/subscribe [::render/sounds])
[was :as before] @heard]
(reset! heard now)
;; The same symbol OF THE SAME DOCUMENT. A
;; different document, or a different symbol, has
;; already asked for its own clock — see
;; `::pb/clock!`'s callers — and re-mixing here as
;; well is a second render of minutes of audio.
(when (and before
(= [id sid] [was-id was-sid])
(not= now before))
(when (and before (= sid was) (not= now before))
(rf/dispatch [::pb/refresh-clock])))))]
;; NOTHING TO RENDER under the graph backend: it plays the mixdown buffer
;; directly and takes its position from the audio context, so there is no
;; element and no WAV for one to hold. The `remix` track above still runs
;; either way — it is what notices an edit to a track, and `with-let` builds
;; it whatever this body returns.
(when-not (clock/graph?)
[: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])}])
[: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 []

6
frontend/src/arthur/ui/stage.cljs
View file

@ -322,11 +322,9 @@
[]
(let [{:keys [world bounds id node]}
@(rf/subscribe [::sub/creation-placement])
;; `::render/clip` rather than `loaded`: this runs at render time, which
;; is the one thing that docstring says the non-reactive read is not for.
document @(rf/subscribe [::render/clip])
n node
label (when id (clip/node-label document id n))]
label (or (:name n) (some-> (node/source n) name)
(when id (if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))]
(when (and world bounds)
(let [[x0 y0 x1 y1] bounds
corners (pairs (through world [x0 y0 x1 y0 x1 y1 x0 y1]))

37
frontend/src/arthur/ui/timeline.cljs
View file

@ -78,10 +78,13 @@
(defn- node-label
"What to call a node in the label column.
See `clip/node-label`, which this defers to: an instance is labelled by the
symbol it places, read through so a rename reaches every row that shows it."
[clip id n]
(clip/node-label clip id n))
A placement's id is a uuid and an authored node's is a keyword, and neither
reads as a name: `(str id)` gives `:face-1` with the colon still on it, or
thirty-six characters of hex that push the column open. `:name` when there is
one, and a legible stand-in when there is not."
[id n]
(or (:name n)
(if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))
(defn- channel-rows [n path depth ->open span]
(let [keyed (filter (comp seq :keys val)
@ -159,7 +162,7 @@
cspan (mapv self (node/placed-span child))
row {:path cpath
:depth depth
:label (node-label clip (:id child) child)
:label (node-label (:id child) child)
:kind :node
:node-kind (:kind child)
:of (node/source child)
@ -212,7 +215,7 @@
{:id (:id child)
:label (or (get-in clip [:symbols (node/source child) :name])
(some-> (node/source child) name)
(node-label clip (:id child) child))
(node-label (:id child) child))
:source (node/source child)
:span (mapv ->open (node/placed-span child))
:keys (into []
@ -269,7 +272,7 @@
[0 (:frames sym)]))
row {:path rpath
:depth depth
:label (node-label clip id n)
:label (node-label id n)
:kind :node
:node-kind (:kind n)
:lane? lane?
@ -336,25 +339,17 @@
(walk sid [] 0 identity)
[])))))
(defn palette-track-row
"`sid`'s palette row: ONE LANE ROW WHETHER OR NOT THE LANE EXISTS YET, because
a person putting a palette transition somewhere is doing the same thing in
either case. Empty, it names the symbol whose palette it would be; filled, it
is the lane symbol's own row under this pane's name for it."
[clip sid frames expanded chosen]
(defn- palette-track-row [clip sid frames expanded chosen]
(let [track-id (get-in clip [:symbols sid :palette-track])
track (get-in clip [:symbols track-id])]
(if (= :palette-track (:type track))
;; A MATERIALIZED TRACK IS AN ORDINARY LANE ROW, selection and all: it is
;; the row `rows` already draws for a lane symbol, wearing this pane's
;; name for it. Only the row of a track that does not exist yet has to say
;; whose palette it would be, which is what creating in it needs.
(-> (first (rows clip track-id expanded chosen))
(assoc :path [::palette-track] :owner track-id
:label "palette" :kind :palette
:expandable? false :expanded? false))
:expandable? false :expanded? false
:select [::palette-track sid]))
{:path [::palette-track] :depth 0 :label "palette" :kind :palette
:lane? true :owner nil :select [::palette-track sid]
:owner nil :select [::palette-track sid]
:span [0 frames] :keys [] :cels []})))
(defn sound-rows
@ -385,7 +380,7 @@
select [:node (:owner n) (:id n) path]
open? (contains? expanded path)
via (when (< 1 (count path)) (str (first path)))
row {:path path :depth 0 :label (node-label clip (:id n) n)
row {:path path :depth 0 :label (node-label (:id n) n)
:kind :node :node-kind :audio :via via
:slides (if via (subvec path 0 1) path)
:select select :expandable? true :expanded? open? :span span
@ -393,7 +388,7 @@
(cons (cond-> row
(< 1 (count tracks))
(assoc :cels (mapv (fn [i track]
{:id i :label (node-label clip (:id track) track)
{:id i :label (node-label (:id track) track)
:span (own-span (node/placed-span track))
:select select})
(range) tracks)))

254
frontend/test/arthur/clock/graph_test.cljs
View file

@ -1,254 +0,0 @@
(ns arthur.clock.graph-test
"The graph clock, asserted against a hand-moved context clock.
The context's `currentTime` is set by these tests rather than advanced by a
device, which is exactly the coupling worth asserting: if any of this counted
time instead of deriving it, moving the clock by hand would not move the
position. A drift bug is invisible for the first second and unmistakable by
the tenth, which is the worst possible shape for a bug to have."
(:require [cljs.test :refer [deftest is testing]]
[arthur.clock.element :as element]
[arthur.clock.graph :as graph]
[arthur.clock.transport :as t]))
(defn- fake-node [log]
(let [n #js {:loop false :playbackRate #js {:value 1.0}}]
(set! (.-connect n) (fn [_] nil))
(set! (.-disconnect n) (fn [] nil))
(set! (.-start n) (fn [_when offset] (swap! log conj [:start offset]) nil))
(set! (.-stop n) (fn [] (swap! log conj [:stop]) nil))
n))
(defn- fake-ctx
"Stands in for an `AudioContext`. `currentTime` is a plain writable property
so a test can move it; the rest is the three methods the backend calls."
[latency log]
(let [ctx #js {:currentTime 0.0 :outputLatency latency :baseLatency 0}]
(set! (.-resume ctx) (fn [] nil))
(set! (.-createBufferSource ctx) (fn [] (fake-node log)))
ctx))
(defn- rig
"A backend, its context, and the log of what it did to its source nodes."
[& {:keys [seconds latency buffer?] :or {seconds 10.0 latency 0 buffer? true}}]
(let [log (atom [])
ctx (fake-ctx latency log)
out #js {:gain #js {:value 1}}]
{:ctx ctx :log log :out out
:g (graph/backend ctx out (when buffer? #js {}) seconds)}))
(defn- at! [{:keys [^js ctx]} t] (set! (.-currentTime ctx) t))
(defn- close?
"Within a frame's worth of a microsecond. Positions compound a multiply and a
subtract, so the last bit of a double is not something to assert on."
[a b]
(< (js/Math.abs (- a b)) 1e-9))
(deftest the-position-is-derived-from-the-context-clock-not-counted
;; Nothing here is ticked. The context moves and the position follows, which
;; is the whole property: a stalled paint loop cannot lose the clock, because
;; the clock was never in the paint loop.
(let [{:keys [g] :as r} (rig)]
(t/-play! g)
(doseq [[now want] [[0.0 0.0] [0.5 0.5] [2.0 2.0] [9.25 9.25]]]
(at! r now)
(is (= want (t/-position g)) (str "context at " now "s")))))
(deftest a-stall-lands-where-the-audio-already-is
;; THE property the derivation buys, same as the element's. A loop that
;; stalled for a third of a second resumes at the position the audio reached,
;; not a third of a second behind it.
(let [{:keys [g] :as r} (rig)]
(t/-play! g)
(at! r 1.0)
(is (= 1.0 (t/-position g)))
(at! r 1.5) ; fifteen frames' worth of stall
(is (= 1.5 (t/-position g)) "and nothing was counted in between")))
(deftest the-position-is-the-speaker-not-the-renderer
;; `currentTime` is the quantum being RENDERED; the speaker is one output
;; latency behind it. Report the renderer and the picture leads the sound by
;; that much, which in a lip-sync tool is the only artefact that matters.
(let [{:keys [g] :as r} (rig :latency 0.05)]
(t/-play! g)
(at! r 2.0)
(is (= 1.95 (t/-position g)) "50ms of output latency, subtracted")
(testing "and scaled by the rate, because a latency is wall time"
(t/-set-rate! g 4.0)
(at! r 3.0)
;; Banked at 1.95 + 0.05 = 2.0, then four seconds of buffer per second of
;; wall clock, less the 4 x 50ms still in the output buffer.
(is (close? 5.8 (t/-position g))))))
(deftest a-rate-change-does-not-lurch-the-playhead
;; THE bug the segments exist for. Audio already rendered cannot be re-rated:
;; read the samples still travelling to the speaker at the NEW rate and the
;; position jumps backwards by three output latencies the instant 1x becomes
;; 4x — fourteen frames at 30fps with a laptop's 150ms, which is a visible
;; lurch on every press of the rate button.
(let [{:keys [g] :as r} (rig :seconds 100.0 :latency 0.15)]
(t/-play! g)
(at! r 2.0)
(let [before (t/-position g)]
(t/-set-rate! g 4.0)
(is (close? before (t/-position g))
"the same instant, read either side of the change")
(testing "and it goes FORWARD from there, at the new rate"
(at! r 2.5)
(is (> (t/-position g) before))
(at! r 3.0)
;; At 3.0s of context the speaker is hearing what was rendered at
;; 2.85s. The rate changed when the renderer was at buffer position
;; 2.0, which is 0.85s of wall clock earlier — so 4 x 0.85 of buffer
;; since, and nothing before that boundary re-rated.
(is (close? (+ 2.0 (* 4 0.85)) (t/-position g)))))
(testing "and back to 1x is continuous too"
(let [before (t/-position g)]
(t/-set-rate! g 1.0)
(is (close? before (t/-position g)))))))
(deftest segments-do-not-pile-up
;; One per rate change, pruned to the in-flight window. Unbounded history
;; would grow for the life of the document.
(let [{:keys [g] :as r} (rig :seconds 1000.0 :latency 0.05)]
(t/-play! g)
(dotimes [i 200]
(at! r (+ 1.0 i))
(t/-set-rate! g (if (even? i) 4.0 1.0)))
(at! r 500.0)
(is (number? (t/-position g)))
(is (<= (count (:segs @(.-state g))) 3)
"the one in force, plus whatever is still in flight")))
(deftest the-first-samples-are-not-the-last-ones
;; Right after a looped play the audible position is a few milliseconds
;; NEGATIVE — the first samples are still in the output buffer. Wrapping
;; before clamping would read that as the very end of the take and jump the
;; playhead there on every play.
(let [{:keys [g] :as r} (rig :seconds 2.0 :latency 0.05)]
(t/-set-loop! g true)
(t/-play! g)
(at! r 0.0)
(is (= 0 (t/-position g)))))
(deftest a-rate-change-is-banked-so-nothing-accumulates
;; 1x -> 4x -> 1x across a take. The anchor moves to where the graph had got
;; to and the new rate applies from there, so switching rates mid-take cannot
;; leave an offset behind — which is what a multiplier on a counted frame
;; would do.
(let [{:keys [g] :as r} (rig :seconds 100.0)]
(t/-play! g)
(at! r 2.0)
(is (= 2.0 (t/-position g)))
(t/-set-rate! g 4.0)
(at! r 3.0)
(is (= 6.0 (t/-position g)) "one second of wall clock, four of buffer")
(t/-set-rate! g 1.0)
(at! r 4.0)
(is (= 7.0 (t/-position g)) "and back to one for one, from six")
(is (= 1.0 (t/-rate g)))))
(deftest a-seek-round-trips
;; Reading back exactly what was seeked to is what makes a scrub idempotent.
(let [{:keys [g]} (rig)]
(doseq [t [0.0 0.5 3.25 9.0]]
(t/-seek! g t)
(is (= t (t/-position g)) (str "seek to " t "s")))))
(deftest a-seek-while-playing-restarts-the-source-at-the-new-offset
;; Source nodes are single-use, so a seek under a playing take has to stop the
;; old one and start a new one at the offset. Checked through the log because
;; an offset that silently stayed at zero would still read back correctly from
;; the arithmetic while playing the wrong audio.
(let [{:keys [g log] :as r} (rig)]
(t/-play! g)
(at! r 1.0)
(reset! log [])
(t/-seek! g 4.0)
(is (= [[:stop] [:start 4.0]] @log))
(is (= 4.0 (t/-position g)))))
(deftest looping-wraps-rather-than-stopping
(let [{:keys [g] :as r} (rig :seconds 2.0)]
(t/-set-loop! g true)
(t/-play! g)
(at! r 5.0)
(is (= 1.0 (t/-position g)) "five seconds into a two-second loop")
(is (t/-playing? g) "and a loop never ends")))
(deftest running-off-the-end-stops-being-playing
;; The end of the sound is the authority on playback having stopped — nothing
;; counts frames to notice it. `ui/player`'s loop reads this to correct the
;; document.
(let [{:keys [g] :as r} (rig :seconds 2.0)]
(t/-play! g)
(at! r 1.9)
(is (t/-playing? g))
(at! r 2.5)
(is (not (t/-playing? g)))
(is (= 2.0 (t/-position g)) "and the position stops at the end, not past it")
(testing "and playing again starts over, as the element does"
(t/-play! g)
(is (= 0.0 (t/-position g))))))
(deftest a-symbol-with-no-sound-still-keeps-time
;; NO BUFFER AT ALL. The element backend had to synthesize silence and encode
;; it to a WAV, full length, so that it had a duration to report; here the
;; length is simply told to the clock and the context does the rest.
(let [{:keys [g log] :as r} (rig :buffer? false :seconds 3.0)]
(t/-play! g)
(is (= [] @log) "and no source node was made for silence")
(at! r 1.0)
(is (= 1.0 (t/-position g)))
(is (t/-playing? g))
(is (= 3.0 (t/-duration g)))
(at! r 3.5)
(is (not (t/-playing? g)) "and silence ends when the symbol does")))
(deftest pause-anchors-at-what-was-heard
;; Resuming replays the last few milliseconds rather than skipping them, which
;; is the kinder of the two roundings.
(let [{:keys [g] :as r} (rig :latency 0.05)]
(t/-play! g)
(at! r 2.0)
(t/-pause! g)
(is (= 1.95 (t/-position g)))
(is (not (t/-playing? g)))
(testing "and the position holds while paused, however the context moves"
(at! r 8.0)
(is (= 1.95 (t/-position g))))))
(deftest releasing-stops-the-source
;; A backend dropped while playing would go on being heard under the one that
;; replaced it: the source is wired to the output the whole app shares.
(let [{:keys [g log] :as r} (rig)]
(t/-play! g)
(at! r 1.0)
(reset! log [])
(t/-release! g)
(is (= [[:stop]] @log))
(is (not (t/-playing? g)))))
(deftest mute-is-the-shared-output-and-not-the-buffer
(let [{:keys [g ^js out]} (rig)]
(t/-set-muted! g true)
(is (= 0 (.-value (.-gain out))))
(t/-set-muted! g false)
(is (= 1 (.-value (.-gain out))))))
(deftest the-two-backends-report-the-same-position
;; The point of keeping both switchable. Everything BELOW the position — the
;; frame derivation, the clamp, the exposure grid — is in `arthur.clock` and
;; shared, so the two backends can only disagree about the position itself. At
;; zero output latency they must not; `clock-test` asserts what is built on
;; top of it, once, for both.
(let [{:keys [g] :as r} (rig :seconds 7.633)]
(t/-play! g)
(doseq [now [0.0 0.034 1.0 1.999 2.0 7.0]]
(at! r now)
(let [e (element/backend #js {:currentTime now :paused false :ended false
:playbackRate 1.0 :duration 7.633})]
(is (= (t/-position e) (t/-position g)) (str "at " now "s"))
(is (= (t/-duration e) (t/-duration g)))
(is (= (t/-playing? e) (t/-playing? g)))))))

21
frontend/test/arthur/domain/clipboard_test.cljs
View file

@ -39,27 +39,6 @@
"an ordinary symbol may contain cropped content beyond its window")
(is (empty? (clip/problems made)))))
(deftest pasting-a-symbol-into-itself-is-refused
;; What happened to a real document: an instance of "bg" was copied from the
;; symbol holding it, and pasted while "bg" itself was the open symbol. Nothing
;; on the paste path looked at the placement graph, so it saved, loaded, and
;; then threw "symbol cycle in audio" out of nest/audio-tracks.
(let [doc (-> (clip/blank)
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil))
id (first (keys (get-in doc [:symbols :outer :nodes])))
payload (:clipboard (clipboard/snapshot doc [(address :outer id [id])]))]
(testing "into the symbol it places"
(let [r (clipboard/paste doc payload :inner 0 {:fresh-id (ids)})]
(is (= "symbol :inner instance :copy-1 places :inner, which is itself"
(:refused r)))
(is (nil? (:clip r)) "and the document is not handed back changed")))
(testing "while pasting it somewhere harmless still works"
(let [r (clipboard/paste doc payload :outer 0 {:fresh-id (ids)})]
(is (nil? (:refused r)))
(is (empty? (clip/problems (:clip r))))))))
(deftest lane-paste-claims-time-as-one-command
(let [doc (fixture/document)
payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))

45
frontend/test/arthur/domain/instance_test.cljs
View file

@ -235,51 +235,6 @@
(is (= (get-in c [:symbols :outer :nodes])
(get-in (leaf/clip "c" (leaf/leaves "c" c)) [:symbols :outer :nodes]))))))
(deftest an-instance-is-labelled-by-what-it-places
(let [c (-> (nested)
(assoc-in [:symbols :inner :name] "mouth"))
[id n] (first (get-in c [:symbols :outer :nodes]))]
(testing "placing does not copy the symbol's name onto the node"
(is (nil? (:name n))
"a cached name is what goes stale; there is nothing to go stale"))
(testing "so the label follows the symbol, including a later rename"
(is (= "mouth" (clip/node-label c id n)))
(is (= "jaw" (clip/node-label (assoc-in c [:symbols :inner :name] "jaw") id n))
"renaming the symbol renames every row that shows an instance of it"))
(testing "an unnamed symbol falls back to its id, not to the node's uuid"
(is (= "inner" (clip/node-label (update-in c [:symbols :inner] dissoc :name)
id n))))
(testing "but a name somebody typed on the instance still wins"
;; Two instances of one symbol are told apart only by this.
(is (= "left eye" (clip/node-label c id (assoc n :name "left eye")))))
(testing "and a node that places nothing is labelled by its own name or id"
(is (= "lid" (clip/node-label c :lid {:id :lid :kind :rect :name "lid"})))
(is (= "lid" (clip/node-label c :lid {:id :lid :kind :rect}))))))
(deftest a-cycle-is-a-problem-and-not-only-a-refusal
;; `place-symbol` and `ui/drag` refuse to MAKE one; this is the document being
;; asked whether it already has one, which is the question every other command
;; — paste above all — gets to ask by calling `clip/problems`.
(let [c (nested)
instance (fn [c host src]
(assoc-in c [:symbols host :nodes :loop]
{:id :loop :kind :instance :z "z" :parent nil
:span [0 10] :time {:mode :map :at 0 :rate 1}
:source {:symbol src}}))]
(testing "a symbol placed inside itself"
(is (= ["symbol :inner instance :loop places :inner, which is itself"]
(clip/problems (instance c :inner :inner)))))
(testing "a symbol placed inside something it already places"
;; Both edges of :outer -> :inner -> :outer close the loop, so both are
;; named: either one is a fair thing to undo.
(let [ps (clip/problems (instance c :inner :outer))]
(is (= 2 (count ps)))
(is (some #{"symbol :inner instance :loop places :outer, which contains it"} ps))
(is (some #(re-find #"^symbol :outer instance .* places :inner, which contains it$" %)
ps))))
(testing "and an instance that closes no loop is still fine"
(is (empty? (clip/problems (instance c :loose :inner)))))))
(deftest a-new-symbol-is-empty-and-placed-where-it-was-asked-for
(let [c (nested)
u #uuid "00000000-0000-4000-8000-000000000001"

44
frontend/test/arthur/events/lane_test.cljs
View file

@ -64,9 +64,6 @@
(is (= :main sid))
(is (= [5 6] (node/placed-span instance)))
(is (= 1 (clip/frames saved source)))
(is (= source (:sid (creation/target saved {} :main
(get-in db [:ui :selection]) 5)))
"an explicitly created cel is immediately its own creation target")
(is (every? (fn [other]
(or (= instance-id (:id other))
(let [[a b] (node/placed-span other)]
@ -75,14 +72,11 @@
(vals (get-in saved [:symbols :main :nodes]))))
"claiming the frame leaves no overlapping cel"))))
(deftest double-click-creation-uses-the-lane-and-the-frame-double-clicked
(deftest double-click-creation-uses-the-lane-and-playhead
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "double-click-new-symbol")]
;; THE PLAYHEAD IS SOMEWHERE ELSE, deliberately: the gesture names a frame
;; as well as a lane, and the empty space double-clicked is where the new
;; symbol goes.
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 9}})
:ui {:open :main} :playback {:frame 5}})
(rf/dispatch-sync [::ui/new-symbol-at 5 [:node :main nil []]])
(let [saved (:clip (store/entry id))
[_ sid instance-id] (get-in @rf-db/app-db [:ui :selection])
@ -94,28 +88,14 @@
(is (= (node/source instance)
(:sid (creation/target saved {} :main selection 5)))
"the new cel can immediately be selected as the creation target")
(is (= 9 (get-in @rf-db/app-db [:playback :frame]))
"creating in a lane does not move the playhead"))))
(deftest the-palette-row-is-a-lane-row-whether-or-not-its-track-exists
(let [empty-row (timeline/palette-track-row (clip/blank) :main 120 #{} nil)
filled (-> (clip/blank)
(assoc-in [:symbols :main :palette-track] :track)
(assoc-in [:symbols :track]
{:id :track :type :palette-track :display :lane
:frames 120 :nodes {}}))
filled-row (timeline/palette-track-row filled :main 120 #{} nil)]
;; The double-click that creates in a lane asks nothing else of a row.
(is (:lane? empty-row))
(is (:lane? filled-row))
(is (= [:node :track nil []] (:select filled-row))
"a track that exists is addressed as the lane it is")))
(is (= 5 (get-in @rf-db/app-db [:playback :frame]))
"the playhead chooses the new cel's time"))))
(deftest the-same-double-click-command-creates-a-palette-symbol-on-the-palette-row
(let [doc (clip/blank)
id (store/install! {:clip doc :store {}} "double-click-palette-symbol")]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 9}})
:ui {:open :main} :playback {:frame 5}})
(rf/dispatch-sync [::ui/new-symbol-at 5
[:arthur.ui.timeline/palette-track :main]])
(let [saved (:clip (store/entry id))
@ -128,19 +108,7 @@
(is (= :palette (get-in saved [:symbols source :type])))
(is (= [5 6] (node/placed-span instance)))
(is (= pal/inherit
(get-in instance [:channels [:palette] :value])))
;; ONCE THE TRACK EXISTS ITS ROW IS AN ORDINARY LANE ROW, which is the
;; address the pane then hands back: the second transition is created by
;; the same command resolving the same way as any other lane's.
(rf/dispatch-sync [::ui/new-symbol-at 20 [:node track-id nil []]])
(let [saved (:clip (store/entry id))
[_ sid2 id2] (get-in @rf-db/app-db [:ui :selection])
second-clip (get-in saved [:symbols sid2 :nodes id2])]
(is (= track-id sid2) "it lands in the same palette track")
(is (= :palette (get-in saved [:symbols (node/source second-clip) :type])))
(is (= [20 21] (node/placed-span second-clip)))
(is (= pal/inherit
(get-in second-clip [:channels [:palette] :value])))))))
(get-in instance [:channels [:palette] :value]))))))
(deftest a-new-lane-uses-the-symbol-selected-at-the-playhead
(let [doc (clip/blank)