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

Add PNG sequence export and uuid-keyed stage placements

Browse source 
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_016JBYKfeMPQTK1WNcgcw41o
This commit is contained in:
Olive Vaughn 2026-09-28 20:47:10 -04:00
parent 3058b9a5f2
commit e22ee600b9
31 changed files with 2642 additions and 178 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -3,12 +3,25 @@
The mix is derived from saved audio track leaves and immutable footage blobs.
The transport still has one audio element, so seeking, rate changes and looping
stay tied to the same clock the picture reads."
stay tied to the same clock the picture reads.
THE AUDIO BUFFER IS THE PRODUCT AND THE WAV IS ONE PACKAGING OF IT. Playback
wants a URL an `<audio>` element can hold; an export wants the samples, either
as WAV bytes to put in an archive or as the `AudioBuffer` a muxer takes as an
audio track. So `buffer!` renders and the two wrappers below it package, rather
than the render being spelled once per consumer."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.node :as node]))
(defn- wav [^js buffer]
(defn wav-bytes
"An `AudioBuffer` -> the bytes of a 16-bit PCM WAV.
PEAK-NORMALISED ONLY IF IT WOULD CLIP. A mix of several tracks can sum past
1.0, and 16-bit PCM has nowhere to put that, so the alternative to scaling is
audible clipping on exactly the loudest moment. Below the threshold nothing is
touched, so a single-track mix is the footage's own audio sample for sample."
[^js buffer]
(let [channels (.-numberOfChannels buffer)
frames (.-length buffer)
rate (.-sampleRate buffer)
@ -35,7 +48,11 @@
(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/URL.createObjectURL (js/Blob. #js [bytes] #js {:type "audio/wav"}))))
(js/Uint8Array. bytes)))
(defn- wav-url [^js buffer]
(js/URL.createObjectURL
(js/Blob. #js [(wav-bytes buffer)] #js {:type "audio/wav"})))
(defn- source! [footage-id]
(-> (js/fetch (str "/api/footage/" footage-id))
@ -73,10 +90,19 @@
(.linearRampToValueAtTime param (* factor v) (/ f fps))
(.setValueAtTime param (* factor v) (/ f fps)))))))
(defn- render! [document sources store]
(defn tracks-of
"The audio nodes of one of the clip's timelines.
A timeline parameter rather than always the root, because a symbol is a
timeline and may carry its own sound. `:main` is the clip's own, which is what
playback mixes."
[document tid]
(filter #(= :audio (:kind %)) (vals (:nodes (clip/timeline document tid)))))
(defn- render! [document tid sources store]
(let [fps (:fps document)
frames (clip/frames document)
tracks (filter #(= :audio (:kind %)) (vals (clip/nodes document)))
frames (:frames (clip/timeline document tid))
tracks (tracks-of document tid)
output (js/OfflineAudioContext.
2 (js/Math.ceil (* (/ frames fps) 44100)) 44100)]
(doseq [track tracks]
@ -104,16 +130,41 @@
(.connect pan (.-destination output))
(.start sound (/ start (:fps document)) (/ (node/local-frame track start) fps))
(.stop sound (/ end (:fps document))))))
(-> (.startRendering output) (.then wav))))
(.startRendering output)))
(defn buffer!
"Promise of the `AudioBuffer` one timeline's audio tracks mix down to, or nil
when it has none.
The raw product. `mix!` packages it as a WAV URL for the transport and
`export/frames` packages it as WAV bytes in an archive; a muxer would take it as
it is, which is why this is the function the others are written in terms of."
([document tid] (buffer! document tid nil))
([document tid store]
(let [tracks (tracks-of document tid)]
(if (empty? tracks)
(js/Promise.resolve nil)
(-> (js/Promise.all
(into-array (map source! (distinct (map #(get-in % [:source :footage]) tracks)))))
(.then (fn [pairs] (render! document tid (into {} (array-seq pairs)) store))))))))
(defn decode!
"Promise of the `AudioBuffer` behind a URL. What a clip whose audio is a plain
file rather than placed tracks exports."
[url]
(-> (js/fetch url)
(.then (fn [^js response]
(when-not (.-ok response)
(throw (ex-info "the clip's audio did not load"
{:url url :status (.-status response)})))
(.arrayBuffer response)))
(.then (fn [bytes]
(.decodeAudioData (js/OfflineAudioContext. 1 1 44100) bytes)))))
(defn mix!
"Promise of a mixed WAV URL, or the original URL for a clip without audio
tracks. Each track can be trimmed and faded independently of its linked picture."
([document fallback-url] (mix! document fallback-url nil))
([document fallback-url store]
(let [tracks (filter #(= :audio (:kind %)) (vals (clip/nodes document)))]
(if (empty? tracks)
(js/Promise.resolve fallback-url)
(-> (js/Promise.all
(into-array (map source! (distinct (map #(get-in % [:source :footage]) tracks)))))
(.then (fn [pairs] (render! document (into {} (array-seq pairs)) store))))))))
(-> (buffer! document clip/root-id store)
(.then (fn [buffer] (if buffer (wav-url buffer) fallback-url))))))

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

@ -89,6 +89,15 @@
;; how scrubbing becomes inspectable in re-frame-10x, and a collaborator's
;; playhead is a feature — putting it outside app-db puts it outside the
;; machinery that would share it.
;; --- export ---
;;
;; The REQUEST and its progress, never the frames. Which timeline to write and
;; at what integer zoom is authored state like anything else; the megabytes the
;; render produces are handed straight to a download and never enter the db.
;; `:isolate` is the placement to render alone, or nil for the whole timeline.
:export {:timeline :main :isolate nil :zoom 4 :busy? false :done 0 :total 0
:status nil}
:playback {:frame 0
:playing? false
:rate 1.0

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

@ -19,31 +19,53 @@
(+ (second base) (* dy (- (wave f 132) y0)))]]))
:linear)))
(defn compose [source]
(defn compose
"The authored layout plus a source clip -> the composed stage document.
A PLACEMENT IS KEYED BY ITS :uuid, not by the authored id. The authored id
(`:left`, `:voice-right`) is a handle for reading the EDN and for the
`:linked-to` written there; it does not appear in the document this returns.
What replaces it is an identity that means one placement and nothing else: seven
instances of one symbol are seven different things to name — to export on their
own, to link a voice to, to point at later — and an id like `:left` is a
description of where a thing sits, which is exactly what changes when the stage
is re-arranged. `:name` carries the label for a human and `:of` carries the
symbol, so the node still says what it is and which drawing it plays."
[source]
(let [{:keys [name width height frames symbol instances audio scale]} layout
default-anchor (or (:anchor layout)
[(/ (:width source) 2) (/ (:height source) 2)])
original (get-in source [:timelines :main])
;; Authored id -> uuid, so the `:linked-to` in the EDN resolves to the
;; identity the document uses. Built before either pass because the audio
;; nodes refer to the instances.
by-id (into {} (map (juxt :id :uuid)) (concat instances audio))
uuid-of (fn [what id]
(or (get by-id id)
(throw (ex-info "the stage layout names a placement that is not there"
{:in what :id id
:known (vec (sort-by str (keys by-id)))}))))
nodes (into
{:root {:id :root :name "stage" :kind :group :z "a1"}}
(map (fn [{:keys [id name z span at in center anchor drift phase]}]
(map (fn [{:keys [uuid name z span at in center anchor drift phase]}]
(let [anchor (or anchor default-anchor)]
[id {:id id :name name :kind :symbol :of symbol
:parent :root :z z :span span
:time {:mode :map :at at :in in :rate 1}
:channels {[:xform :pos] (if drift
(position-track center anchor drift phase frames)
(ch/framed (mapv - center anchor)))
[:xform :anchor] {:animated? false :value anchor}
[:xform :scale] scale}}]))
[uuid {:id uuid :name name :kind :symbol :of symbol
:parent :root :z z :span span
:time {:mode :map :at at :in in :rate 1}
:channels {[:xform :pos] (if drift
(position-track center anchor drift phase frames)
(ch/framed (mapv - center anchor)))
[:xform :anchor] {:animated? false :value anchor}
[:xform :scale] scale}}]))
instances))
nodes (into nodes
(map (fn [{:keys [id linked-to z source span at in gain pan]}]
[id {:id id :kind :audio :parent :root :z z
:linked-to linked-to :source source :span span
:time {:mode :map :at at :in in :rate 1}
:channels (cond-> {[:audio :gain] gain}
pan (assoc [:audio :pan] pan))}])
(map (fn [{:keys [uuid linked-to z source span at in gain pan]}]
[uuid {:id uuid :kind :audio :parent :root :z z
:linked-to (uuid-of uuid linked-to)
:source source :span span
:time {:mode :map :at at :in in :rate 1}
:channels (cond-> {[:audio :gain] gain}
pan (assoc [:audio :pan] pan))}])
audio))]
(cond-> (assoc source :name name :width width :height height
:timelines {:main {:id :main :frames frames :nodes nodes}

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

@ -20,11 +20,13 @@
;; Audio placements are ordinary timeline nodes with channel parameters.
;; :linked-to is an editorial link; their spans and time maps are independent.
:audio
[{:id :voice-left :linked-to :left :z "a3"
[{:id :voice-left :uuid #uuid "eeaa49c3-1238-469f-bf54-44929e379f6b"
:linked-to :left :z "a3"
:source {:footage "f8cace9e-4ad3-4796-973c-c62eeebe3d01"}
:span [0 280] :at 0 :in 0
:gain {:animated? false :value 1.0}}
{:id :voice-right :linked-to :right :z "a4"
{:id :voice-right :uuid #uuid "468239dd-0e3a-4e5c-ac6f-1858430a0355"
:linked-to :right :z "a4"
:source {:footage "f8cace9e-4ad3-4796-973c-c62eeebe3d01"}
:span [48 260] :at 48 :in 0
:gain {:animated? true :interp :linear
@ -34,25 +36,42 @@
:pan {:animated? true :interp :linear
:keys {48 -0.8, 90 -0.8, 130 0.7, 175 0.7, 220 -0.65, 259 0.65}
:over []}}]
;;
;; EVERY PLACEMENT CARRIES A :uuid, and it is authored here rather than generated
;; in `compose`. The uuid is the node's identity in the composed document — it is
;; the key in the timeline's node map — so generating one per load would give the
;; same stage a different document on every load, and nothing that refers to a
;; placement (`:linked-to` above, an export target in the UI, a comment in a
;; review) could survive a reload. The `:id` beside it stays as the AUTHORING
;; handle: it is what the reader of this file uses to see which placement is
;; which, and what the `:linked-to` above names, and `compose` resolves it to the
;; uuid. Nothing downstream of `compose` sees the authored id.
:instances
[{:id :left :name "8625 left" :z "a1"
[{:id :left :uuid #uuid "ee7321c8-faf1-46d7-8029-37771898accb"
:name "8625 left" :z "a1"
:span [0 280] :at 0 :in 0
:center [40 40] :drift [3 2] :phase 0}
{:id :right :name "8625 right" :z "a2"
{:id :right :uuid #uuid "1aa0da78-b4ed-4bb6-8d70-b09a3ec5e2c3"
:name "8625 right" :z "a2"
:span [48 280] :at 48 :in 0
:center [120 40] :drift [-3 2] :phase 17}
{:id :top-third :name "8625 top third" :z "a5"
{:id :top-third :uuid #uuid "23bb697d-eba7-4af6-a86c-606c50107088"
:name "8625 top third" :z "a5"
:span [24 280] :at 24 :in 0
:center [200 40] :drift [2 -3] :phase 31}
{:id :top-fourth :name "8625 top fourth" :z "a6"
{:id :top-fourth :uuid #uuid "f4f0241d-026e-4e50-9bea-a4ccde896d8a"
:name "8625 top fourth" :z "a6"
:span [72 280] :at 72 :in 0
:center [280 40] :drift [-2 -2] :phase 49}
{:id :bottom-left :name "8625 bottom left" :z "a7"
{:id :bottom-left :uuid #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
:name "8625 bottom left" :z "a7"
:span [96 280] :at 96 :in 0
:center [70 135] :drift [3 -2] :phase 63}
{:id :bottom-middle :name "8625 bottom middle" :z "a8"
{:id :bottom-middle :uuid #uuid "63f3fb32-9e94-4d68-a1c2-12e6de2d04b5"
:name "8625 bottom middle" :z "a8"
:span [120 280] :at 120 :in 0
:center [160 135] :drift [-2 3] :phase 81}
{:id :bottom-right :name "8625 bottom right" :z "a9"
{:id :bottom-right :uuid #uuid "fa338701-cb21-4d45-89f1-a5e706f045ec"
:name "8625 bottom right" :z "a9"
:span [144 280] :at 144 :in 0
:center [250 135] :drift [2 2] :phase 107}]}

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

@ -108,9 +108,17 @@
Each instance owns its own timeline resolver, so two offsets never share a
channel cursor or point buffer. The returned ops must be drawn before the next
frame, as with timeline/resolver."
([clip store] (resolver clip store pal/index-of))
([clip store palette]
frame, as with timeline/resolver.
`root` is which timeline to resolve AS the root, and it defaults to the clip's.
Passing a symbol's id is the whole of \"render that symbol\": a library timeline
and the clip's own are the same type, so a symbol resolves by being rooted
rather than by a second code path — which is the return on collapsing the two
into `domain/timeline`. Its frame space is its own `:frames`, and nested symbols
inside it still resolve, because this is the function that knows how to do that."
([clip store] (resolver clip store pal/index-of root-id))
([clip store palette] (resolver clip store palette root-id))
([clip store palette root]
(letfn [(build [tid chain]
(when (some #{tid} chain)
(throw (ex-info "symbol timeline cycle" {:chain (conj chain tid)})))
@ -143,7 +151,7 @@
[]))
(when-let [op (get by-id id)] [op]))))
ids))))))]
(build root-id []))))
(build root []))))
(defn problems
"Human-readable reasons this clip will not evaluate or will not save. Empty

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

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

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

@ -69,10 +69,27 @@
{:id id})))
(str/replace s "/" "~")))
(def ^:private uuid-segment
"Canonical UUID form: 8-4-4-4-12 hex digits, and nothing else.
A PLACEMENT'S ID IS A UUID — see `demo/stage/compose` for why — and a leaf path
is text, so reading one back has to decide which ids are uuids and which are
keywords. It decides by SHAPE, which is a judgement worth stating: a keyword
that happened to be thirty-six characters of hex in exactly this grouping would
come back a uuid. Nothing names a node that by hand, and the alternative — a
sigil on every segment — would change the shape of every path in every leaf to
disambiguate a case that does not arise. `^` and `$` are the load-bearing part;
without them a longer id CONTAINING a uuid would match."
#"^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$")
(defn unsegment
"One path segment -> the id it names."
"One path segment -> the id it names: a uuid when it is shaped like one, a
keyword otherwise."
[s]
(keyword (str/replace s "~" "/")))
(let [s (str/replace s "~" "/")]
(if (re-find uuid-segment s)
(uuid s)
(keyword s))))
(defn- prop->path
"A channel's property vector -> one path segment. `[:geom :pts]` is \"geom.pts\"

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

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

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

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

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

@ -0,0 +1,216 @@
(ns arthur.events.export
"Export, as intents and one effect.
The walk is not an event and must not become one: it is a promise chain that
runs for as long as the timeline is long, and re-frame events are the wrong unit
for something with a middle. So `::start` collects what the render needs out of
the db and hands it to an fx, and the fx dispatches progress back — the same
arrangement `events/project`'s save uses, and for the same reason.
WHAT GOES IN THE DB IS THE REQUEST AND THE PROGRESS, never the frames. A
megabyte of PNG in app-db would be compared by every mounted subscription on
every tick."
(:require [arthur.domain.palette :as pal]
[arthur.export :as export]
[arthur.export.frames :as frames]
[arthur.footage.store :as store]
[clojure.string :as str]
[re-frame.core :as rf]))
(def zooms
"The integer zooms offered. 320x200 times these is 320x200 up to 1920x1200.
INTEGERS ONLY, and the list is short for that reason rather than for tidiness:
a stage at a non-integer scale has to invent pixels, and there is nothing in
this tool downstream of `domain/raster` that is allowed to. 6 is here because
1920 wide is what a delivery timeline usually is; the 1200 height that comes
with it is 16:10 and is the project's aspect, not a mistake to letterbox away."
[1 2 3 4 6])
(defn- stem
"A filesystem-safe name for the artefact: the clip's label and the target's.
The target is in the name because the clip, each symbol in its library and each
placement on its stage are all exportable, and they would otherwise land in the
downloads folder as the same file. It is the target's LABEL rather than its id
because a placement's id is a uuid, and `arthur-8f594d72-a97f-....zip` names
nothing to the person who has to find it again."
[label target]
(-> (str (or label "arthur") "-" (or target "main"))
(str/replace #"[^A-Za-z0-9._-]+" "-")
(str/replace #"^-+|-+$" "")
(str/lower-case)))
(defn target-value
"An export target as a `<select>` option value.
Two kinds, told apart by a leading letter: `t:<timeline>` is a whole timeline,
`n:<timeline>:<node>` is one placement inside one. The parts are joined with `:`
because neither a timeline id nor a uuid contains one.
IT CARRIES THE NAMESPACE. `(name :sym/face-8625)` is \"face-8625\", and a value
written that way cannot be read back: `keyword` on it gives `:face-8625`, which
is not a key in `:timelines`, so the plan silently becomes nil and the export
throws \"there is no such timeline\" from inside re-frame's `:do-fx`. That
presented as the tab locking up rather than as an error — see `::run!` below for
the other half of why — and it is the reason this is a named pair of functions
with a test rather than `name` and `keyword` at the two ends of a select."
[{:keys [timeline isolate]}]
(let [tl (subs (str (or timeline :main)) 1)]
(if isolate (str "n:" tl ":" isolate) (str "t:" tl))))
(defn target-id
"The inverse of `target-value`. `keyword` splits on the `/` itself, so a
namespaced timeline id survives; a placement comes back a uuid, which is what
the node map is keyed by."
[v]
(let [[kind tl node] (str/split v #":")]
(cond-> {:timeline (keyword tl)}
(= "n" kind) (assoc :isolate (uuid node)))))
(defn targets
"Everything an export can be pointed at, in the order the picker lists them.
THREE KINDS, and the distinction is the point. `:main` is the clip. A symbol
timeline is the DRAWING — one file however many times it is placed, in its own
frame space. A placement is that drawing WHERE IT SITS: the stage's length and
rate, with the other placements removed, which is why seven instances of one
symbol are seven different exports rather than seven copies of one.
Placements are ordered and labelled by `:name`, never by id: a uuid sorts at
random and means nothing to read."
[clip]
(let [libs (cons :main (sort-by str (remove #{:main} (keys (:timelines clip)))))
placements (->> (get-in clip [:timelines :main :nodes])
(filter (comp #{:symbol} :kind val))
(sort-by (fn [[id n]] [(or (:name n) "") (str id)])))]
(into (mapv (fn [tid]
{:timeline tid
:label (if (= :main tid) "main (the clip)" (name tid))})
libs)
(mapv (fn [[id n]]
{:timeline :main :isolate id
:label (or (:name n) (str id))})
placements))))
(defn- label-of
"The label of the target `db` currently points at, for the filename."
[clip {:keys [timeline isolate]}]
(:label (or (first (filter #(and (= timeline (:timeline %))
(= isolate (:isolate %)))
(targets clip)))
{:label (some-> timeline name)})))
(rf/reg-sub ::state (fn [db _] (:export db)))
(rf/reg-sub
::targets
(fn [db _]
(targets (:clip (store/entry (:clip/current db))))))
(rf/reg-sub
::plan
(fn [db _]
(let [{:keys [clip]} (store/entry (:clip/current db))
{:keys [timeline zoom isolate]} (:export db)]
(export/plan {:clip clip :timeline timeline :zoom zoom :isolate isolate
:picture-fps (get-in db [:clip :display-fps])}))))
(rf/reg-event-db
::set-target
;; Both keys always, so switching from a placement back to a whole timeline
;; clears the isolate rather than leaving it to filter the new target.
(fn [db [_ {:keys [timeline isolate]}]]
(update db :export merge {:timeline (or timeline :main) :isolate isolate})))
(rf/reg-event-db
::set-zoom
(fn [db [_ z]] (assoc-in db [:export :zoom] z)))
(rf/reg-event-fx
::start
(fn [{:keys [db]} _]
(if (get-in db [:export :busy?])
{}
(let [id (:clip/current db)
entry (store/entry id)
{:keys [timeline zoom isolate]} (:export db)]
{:db (update db :export merge {:busy? true :done 0
:total (:frames (export/plan
{:clip (:clip entry)
:timeline timeline
:isolate isolate
:zoom zoom}))
:status "rendering…"})
::run! {:clip (:clip entry)
:timeline timeline
:isolate isolate
:store (:store entry)
;; The same palette and ramp the preview resolves and blits
;; through. Read here rather than in the fx so that the effect
;; takes data and nothing else.
:palette (get {:arthur/default pal/index-of}
(:palette db) pal/index-of)
:ramp (get {:arthur/default pal/rgb} (:palette db) pal/rgb)
:zoom zoom
:picture-fps (get-in db [:clip :display-fps])
:audio-url (:audio entry)
:name (stem (:label entry)
(label-of (:clip entry)
{:timeline timeline :isolate isolate}))}}))))
(rf/reg-event-db
::progress
(fn [db [_ done total]]
(update db :export merge {:done done :total total})))
(rf/reg-event-db
::done
(fn [db [_ filename bytes]]
(update db :export merge
{:busy? false
:status (str "wrote " filename " · "
(.toFixed (/ bytes 1048576) 1) " MB")})))
(rf/reg-event-db
::failed
(fn [db [_ message]]
(update db :export merge {:busy? false :status (str "export failed: " message)})))
(defn- download!
"Hand the browser a blob as a file.
The object URL is revoked on a timeout rather than immediately: the click starts
the download asynchronously and revoking in the same turn cancels it in some
browsers, which presents as the button doing nothing at all."
[filename ^js blob]
(let [url (js/URL.createObjectURL blob)
a (.createElement js/document "a")]
(set! (.-href a) url)
(set! (.-download a) filename)
(.appendChild (.-body js/document) a)
(.click a)
(.removeChild (.-body js/document) a)
(js/setTimeout #(js/URL.revokeObjectURL url) 30000)))
(rf/reg-fx
::run!
(fn [spec]
;; THE CALL IS GUARDED because `export/run!` validates its request BEFORE it
;; returns a promise, so a bad timeline id throws synchronously — here, inside
;; re-frame's `:do-fx` interceptor. An uncaught throw there never reaches the
;; `.catch` below, so `::failed` never dispatches and `:busy?` stays true: the
;; button sits disabled on \"rendering…\" and the readout on \"frame 0 /\"
;; forever. That reads as the tab having locked up, which is the worst way for
;; an export to fail — there is nothing to see and nothing in the status line.
;; Turning the throw into a rejection gives every failure one path to the user.
(-> (try (export/run! spec
(frames/exporter)
(fn [done total] (rf/dispatch [::progress done total])))
(catch :default e (js/Promise.reject e)))
(.then (fn [{:keys [filename ^js blob]}]
(download! filename blob)
(rf/dispatch [::done filename (.-size blob)])))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))

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

@ -89,7 +89,7 @@
(let [gaps (detect/fill-gaps @raw)]
(mark! "fill-gaps")
(assoc gaps :dimensions [w h] :crops @crops
:interior @inner)))))))
:interior @inner :interior-settings take/knobs)))))))
(defn- build-clip [manifest detector
{:keys [dense detected dimensions interior missing first-real]
@ -131,6 +131,7 @@
(-> (http/GET (str "/api/blocks/" key))
(.then (fn [block]
(assoc track :interior (source/unpack-interior block take/knobs frames)
:interior-settings take/knobs
:interior-key key)))
(.catch (fn [error]
(if (= 404 (:status (ex-data error))) track (throw error)))))))
@ -153,27 +154,37 @@
(saved-source! (:id (take/analysis-for manifest detector))
[(:width manifest) (:height manifest)]))
(defn- measure-cached! [track]
;; Older analyses may lack the optional interior block. Spread their one-time
;; measurement over event-loop turns just like the fresh decode path.
(if (:interior track)
(defn measure-crops!
"Measure every retained crop's interior, ONE PER EVENT-LOOP TURN.
Done in a tight loop instead, it is ten seconds of synchronous arithmetic with
the main thread held and the frame counter frozen on its last value — which
reads as the decoder hanging, and was diagnosed as that twice.
Two callers, and the only difference between them is who is waiting: opening an
older analysis that predates the interior block backfills it behind a progress
line, and a knob drag that needs the pixels measured at new settings does the
same work with nobody watching, so it passes no `on-step`. The settings ride
back on the track, because a measurement and the knobs it was taken at are one
fact — `source/pack` will not address an interior block without them."
[settings track on-step]
(if (or (:interior track) (not (:crops track)))
(js/Promise.resolve track)
(let [crops (:crops track)
total (count crops)
interior (atom [])]
(js/Promise.
(fn [resolve reject]
(letfn [(step [i]
(if (= i total)
(resolve (assoc track :interior @interior))
(try
(swap! interior conj (source/measure-crop take/knobs (nth crops i)))
(when (or (zero? i) (zero? (mod (inc i) 4)) (= (inc i) total))
(rf/dispatch [::progress
(str "measuring " (inc i) "/" total)]))
(js/setTimeout #(step (inc i)) 0)
(catch :default error (reject error)))))]
(step 0)))))))
total (count crops)
interior (atom [])]
(js/Promise.
(fn [resolve reject]
(letfn [(step [i]
(if (= i total)
(resolve (assoc track :interior @interior
:interior-settings settings))
(try
(swap! interior conj (source/measure-crop settings (nth crops i)))
(when on-step (on-step (inc i) total))
(js/setTimeout #(step (inc i)) 0)
(catch :default error (reject error)))))]
(step 0)))))))
(rf/reg-fx
::begin!
@ -186,7 +197,13 @@
(.then (fn [track]
(if track
(do (rf/dispatch [::progress "reusing saved analysis…"])
(-> (measure-cached! track)
(-> (measure-crops!
take/knobs track
(fn [done total]
(when (or (= 1 done) (zero? (mod done 4))
(= done total))
(rf/dispatch
[::progress (str "measuring " done "/" total)]))))
(.then (fn [measured]
(build-clip manifest detector measured)))))
(do (rf/dispatch [::progress "loading MediaPipe…"])

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

@ -210,24 +210,6 @@
(defonce ^:private retained-source (atom nil))
(defonce ^:private retained-interior (atom nil))
(defn- measure-crops! [inputs settings]
;; Existing analyses without an interior block pay this once. One crop per
;; event-loop turn keeps playback responsive during that backfill.
(if (or (:interior inputs) (not (:crops inputs)))
(js/Promise.resolve inputs)
(js/Promise.
(fn [resolve reject]
(let [crops (:crops inputs)
measured (atom [])]
(letfn [(step [i]
(if (= i (count crops))
(resolve (assoc inputs :interior @measured))
(try
(swap! measured conj (source/measure-crop settings (nth crops i)))
(js/setTimeout #(step (inc i)) 0)
(catch :default error (reject error)))))]
(step 0)))))))
(defn- retained-interior! [analysis settings inputs]
(let [frames (count (:crops inputs))
block-key (source/interior-key analysis settings frames)]
@ -238,7 +220,7 @@
:interior-key block-key)))
(.catch (fn [error]
(if (= 404 (:status (ex-data error)))
(-> (measure-crops! (dissoc inputs :interior) settings)
(-> (footage/measure-crops! settings (dissoc inputs :interior) nil)
(.then (fn [measured]
(let [{:keys [key descriptor data]}
(source/interior-block analysis settings

242
frontend/src/arthur/export.cljs Normal file
View file

@ -0,0 +1,242 @@
(ns arthur.export
"Export a TIMELINE: one frame walk, and a sink that decides what comes out.
THE SINK IS A PROTOCOL because there is more than one right answer to \"a
video file\" and they disagree about the thing this project cares most about.
A PNG sequence is bit-exact — the file holds the bytes `raster/draw-ops!`
produced, expanded through the ramp and nothing else. A muxed MP4 is one file
that plays anywhere, and every codec a browser can reach either subsamples
chroma (which puts fringes on precisely the hard flat-colour edges the whole
idiom is made of) or is a codec an NLE will not open. Those are different
trades for different jobs, not a better and a worse, so both should be
reachable and neither should be the other's special case.
What is genuinely shared is everything above the sink, and it is most of the
work: rooting the resolver at the chosen timeline, the picture-rate time map,
the raster, the frame loop, the audio mix, the progress reporting and the
yielding that lets the page paint. So `run!` owns all of that and calls three
methods.
TWO RULES THE WALK ENFORCES, both about sync:
Every frame of the timeline's frame space is emitted, at the CLIP's rate. A
lower picture rate holds a pose across several frames — it never drops them —
so the exported duration matches the audio no matter what the picture rate is.
Decimating instead is how an export silently runs short and the sound slides
off the picture, which is the one artefact this tool exists to prevent.
The zoom is an INTEGER. A pixel becomes a block of identical pixels. Anything
else resamples, and `domain/png` and `ui/canvas` both have the longer argument
for why that is not allowed to happen here."
;; `run!` is the verb this namespace is about, and nothing here folds a
;; side-effect over a seq, so core's loses the name rather than ours.
(:refer-clojure :exclude [run!])
(:require [arthur.audio.mix :as mix]
[arthur.domain.clip :as clip]
[arthur.domain.raster :as raster]))
(defprotocol Exporter
"A sink for a rendered timeline. Implementations live under `arthur.export.*`.
Called in this order, once, per export: `begin!`, then `frame!` for every frame
in order from 0, then `finish!`. Any of them may return a promise and the walk
waits for it, which is what keeps a slow encoder from being fed faster than it
drains and what gives the page a chance to paint between frames.
`Exporter` rather than `IExporter`, which is what `domain/timeline`'s
`IResolver` would suggest, because it names a role a thing plays rather than a
capability a value has."
(begin! [this spec]
"Prepare to receive frames.
`spec` carries everything constant for the export:
:name a filesystem-safe stem for the artefact
:width stage width in raster pixels, before zoom
:height stage height, before zoom
:zoom integer pixel multiplier
:fps frames per second of the finished file — the CLIP's rate
:frames how many frames will arrive
:ramp index -> [r g b], the palette to expand through
:audio an AudioBuffer, or nil when the timeline has no sound
The ramp and the audio are here rather than on `frame!` because neither
changes across an export, and a muxer has to declare its tracks before it
will accept a sample.")
(frame! [this i raster]
"Take frame `i`, an indexed `domain/raster`.
THE RASTER IS REUSED and must be consumed before this returns (or before the
promise it returns settles). The walk hands back the same buffer every frame,
for the same reason `timeline/resolver` reuses its point buffers: a 900-frame
export that allocates a stage per frame is a tab that swaps. A sink that wants
to keep pixels has to copy or encode them here.")
(finish! [this]
"Close the artefact. Promise of `{:filename :blob}`."))
(defn kin
"The ids to keep when isolating `id` in `nodes`.
Four things, and each for its own reason:
the node itself;
everything ABOVE it, because a placement's transform is relative to its
parent and dropping the chain would move the thing being isolated;
everything BELOW it, because a group instance is its children;
any audio track `:linked-to` it, because the link is the statement that this
sound belongs to that placement, and a face exported without its voice is
not the thing that was asked for.
Siblings go. That is the whole point: what comes out is one placement, where it
sits, on the timeline it sits on."
[nodes id]
(let [up (loop [i id acc #{}]
(if (or (nil? i) (contains? acc i))
acc
(recur (:parent (get nodes i)) (conj acc i))))
down (loop [edge #{id} acc #{}]
(if (empty? edge)
acc
(let [acc' (into acc edge)]
(recur (set (for [[k n] nodes
:when (and (contains? edge (:parent n))
(not (contains? acc' k)))]
k))
acc'))))
kept (into up down)]
(into kept
(for [[k n] nodes
:when (and (= :audio (:kind n)) (contains? kept (:linked-to n)))]
k))))
(defn isolate
"The timeline with only `id` and its kin kept. `nil` leaves it alone.
The FRAME SPACE IS UNTOUCHED, which is what makes this different from exporting
the symbol a placement plays. Rooting at `:sym/face-8625` renders the drawing in
its own time, identically for all seven placements. Isolating one placement
renders the STAGE — its length, its rate, the placement's span, drift and scale
— with the other six removed. The first is the drawing; the second is that face
on the stage, and they are different deliverables."
[tl id]
(if (and id (get-in tl [:nodes id]))
(update tl :nodes select-keys (kin (:nodes tl) id))
tl))
(defn- sampled
"The timeline with picture-rate sampling written onto its root node's time map.
The same transform `subs/render/::timeline` applies for playback, and
deliberately the same one: an export that sampled poses differently from the
preview would make the preview a lie about the deliverable. Only the root node's
time map changes — the dense source track stays at its native rate, and the
frame COUNT is untouched, which is what keeps the duration and therefore the
audio right."
[tl source-fps picture-fps]
(if (and picture-fps source-fps (< picture-fps source-fps))
(-> tl
(assoc-in [:nodes :root :time :source-fps] source-fps)
(assoc-in [:nodes :root :time :sample-fps] picture-fps))
tl))
(defn- yield!
"Hand the event loop a turn between frames.
`setTimeout 0` and not a resolved promise: a promise continuation is a
microtask, so a chain of them runs to completion without the browser ever
painting, and the progress readout would jump from 0 to done. `flow/ingest`'s
decode loop pauses for the same reason."
[]
(js/Promise. (fn [resolve] (js/setTimeout resolve 0))))
(defn audio!
"Promise of the AudioBuffer to export alongside the picture, or nil.
A timeline's own placed audio tracks win. Failing that, the ROOT timeline — and
only the root — falls back to the clip's audio file, which is where a take's
sound lives before anyone has placed a track. A symbol exports silence rather
than the whole clip's soundtrack, because a symbol's frame space is its own and
the clip's audio is not a fact about it."
[clip-doc tid store fallback-url]
(-> (mix/buffer! clip-doc tid store)
(.then (fn [buffer]
(cond
buffer buffer
(and (= tid clip/root-id) fallback-url) (mix/decode! fallback-url)
:else nil)))))
(defn plan
"What an export of `tid` will produce, without producing any of it.
Separate from `run!` so the UI can show the size and length it is about to
commit to, and so the arithmetic is assertable without a sink."
[{:keys [clip timeline zoom picture-fps] isolate-id :isolate}]
(let [tl (some-> (clip/timeline clip timeline) (isolate isolate-id))
zoom (max 1 (js/Math.floor (or zoom 1)))]
(when tl
{:frames (:frames tl)
:fps (:fps clip)
:zoom zoom
:width (* (:width clip) zoom)
:height (* (:height clip) zoom)
:seconds (/ (:frames tl) (:fps clip))
;; The poses the picture actually holds, which is what a lower picture rate
;; changes. The frame COUNT does not move — see the namespace docstring.
:poses (if (and picture-fps (< picture-fps (:fps clip)))
(js/Math.ceil (* (/ (:frames tl) (:fps clip)) picture-fps))
(:frames tl))})))
(defn run!
"Render `timeline` into `exporter`. Promise of `{:filename :blob}`.
`on-progress` is called with `[done total]` as frames complete, and is where a
UI hangs its readout."
[{:keys [clip timeline store palette ramp zoom picture-fps name audio-url]
isolate-id :isolate}
exporter on-progress]
(let [tl (some-> (clip/timeline clip timeline) (isolate isolate-id))]
(when-not tl
(throw (ex-info "there is no such timeline to export"
{:timeline timeline
:timelines (vec (sort-by str (keys (:timelines clip))))})))
(let [{:keys [frames fps zoom]} (plan {:clip clip :timeline timeline :zoom zoom
:isolate isolate-id})
;; Rooted at the chosen timeline, so exporting a symbol is exporting a
;; clip whose root that symbol is. Nested symbols inside it still
;; resolve — clip/resolver is the function that knows how.
doc (assoc-in clip [:timelines timeline]
(sampled tl (:fps clip) picture-fps))
resolve-frame (clip/resolver doc store palette timeline)
ras (raster/make (:width clip) (:height clip))
bg (get palette :bg 0)]
(-> (audio! doc timeline store audio-url)
(.then (fn [audio]
(js/Promise.resolve
(begin! exporter {:name name :width (:width clip)
:height (:height clip) :zoom zoom
:fps fps :frames frames :ramp ramp
:audio audio}))))
(.then (fn [_]
;; A fold over the frames as a promise CHAIN rather than a
;; doseq: each frame has to wait for the last one's sink to
;; drain, and `reduce` building that chain is the shape that
;; says so. Nothing here is concurrent on purpose — an encoder
;; fed from two places at once is not fast, it is wrong.
(reduce
(fn [chain i]
(.then chain
(fn [_]
(-> ras
(raster/clear! bg)
(raster/draw-ops! (resolve-frame i)))
(-> (js/Promise.resolve (frame! exporter i ras))
(.then (fn [_]
(when on-progress
(on-progress (inc i) frames))
(yield!)))))))
(js/Promise.resolve)
(range frames))))
(.then (fn [_] (finish! exporter)))))))

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

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

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

@ -187,6 +187,40 @@
[knob]
(get knob-roles knob #{}))
(def area-roles
"Feature area -> the block roles `freeze/part` freezes for it.
The other half of a question neither table answers alone. `block-knobs` says
which knobs reach a ROLE's bytes; this says which roles a FEATURE owns; and what
a regeneration actually asks is which knobs reach one feature."
{:mouth ["geom"]
:eye ["eyes" "iris-pos"]
:brow ["brows" "brow-pos"]
:teeth ["teeth"]})
(def framed-knobs
"Feature area -> the knobs its TIER 1 channels read.
What `block-knobs` cannot answer and deliberately does not: a framed radius and a
keyed `[:vis]` hold no bytes, so no block key moves when they move — and a
re-freeze still has to happen or the knob does nothing at all. This is the half
that used to live nowhere, and a regeneration had to guess at with a per-knob
special case. `regenerate-test` asserts the biconditional over the union, the
same way `address-test` does for `block-knobs`, so it is checked and not believed.
`:aperture-cut` is here AND in the teeth block: it gates `mouth-in`'s visibility
in tier 1 and the interior contour's smoothing in tier 2. One knob, two features,
two routes — which is exactly why this cannot be a per-area list of its own."
{:mouth #{:aperture-cut}
:eye #{:blink-cut :iris-size :pupil-size}
:brow #{}
:teeth #{}})
(defn area-knobs
"Every knob one feature area's frozen output depends on, across both tiers."
[area]
(into (get framed-knobs area #{}) (mapcat block-knobs) (get area-roles area)))
(defn block-descriptor
"The canonical text naming one dense block.

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

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

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

@ -3,7 +3,6 @@
measurement block. Everything after this boundary can run without PNGs or
MediaPipe. Mouth crops retain pixels for settings that change the measurement."
(:require [arthur.domain.landmarks :as lm]
[arthur.domain.params :as params]
[arthur.domain.wire :as wire]
[arthur.flow.address :as address]
[arthur.flow.measure.interior :as interior]))
@ -90,8 +89,13 @@
{:role role :data data}))
(defn pack
"Dense landmarks, mask, crops and optional pixel measurements -> source blocks."
[analysis {:keys [dense detected crops interior]}]
"Dense landmarks, mask, crops and optional pixel measurements -> source blocks.
`:interior-settings` is not optional when `:interior` is present: the block is
addressed BY those knobs, and defaulting them here would name a block after
settings its bytes did not come from — a content address that lies, which is the
one failure the key exists to prevent."
[analysis {:keys [dense detected crops interior interior-settings]}]
(let [frames (count dense)
points (count (first dense))]
(when-not (and (pos? frames) (pos? points)
@ -119,16 +123,25 @@
(aset landmarks (+ base 2) z)))
(when-let [crop (nth crops f)]
(.set pixels (:data crop) (nth offsets f))))
(cond-> {"source/dense" (named "source/dense" analysis ["landmarks"]
{:type "float64" :frames frames :points points :stride (* 3 points)}
landmarks)
"source/detected" (named "source/detected" analysis ["detected"]
{:type "uint8" :frames frames :stride 1} mask)
"source/crops" (named "source/crops" analysis ["rgba"]
{:type "uint8" :frames frames :boxes boxes :offsets offsets}
pixels)}
(cond-> {"source/dense"
(named "source/dense" analysis ["landmarks"]
{:type "float64" :frames frames :points points
:stride (* 3 points)}
landmarks)
"source/detected"
(named "source/detected" analysis ["detected"]
{:type "uint8" :frames frames :stride 1} mask)
"source/crops"
(named "source/crops" analysis ["rgba"]
{:type "uint8" :frames frames :boxes boxes :offsets offsets}
pixels)}
interior (assoc "source/interior"
(interior-block analysis params/defaults interior))))))
(interior-block
analysis
(or interior-settings
(throw (ex-info "an interior block needs the settings its measurements were taken at"
{:frames (count interior)})))
interior))))))
(defn wire-blocks [blocks]
(into-array

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

@ -9,6 +9,7 @@
[arthur.db :as db]
[arthur.domain.feature :as feature]
[arthur.domain.params :as params]
[arthur.events.export :as export]
[arthur.events.footage :as footage]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
@ -22,10 +23,23 @@
(defonce ^:private selected-owner (r/atom nil))
(defonce ^:private drafts (r/atom {}))
(defn- instance-label
"What to call a symbol instance in the UI.
Its `:name`, because a placement's id is a UUID and a uuid is not something to
show anyone or to sort by. The id is the fallback only so that a node with no
name still has a row rather than a blank one."
[clip id]
(or (get-in clip [:timelines :main :nodes id :name]) (str id)))
(defn- setting-owners [clip]
(let [instances (for [[id node] (get-in clip [:timelines :main :nodes])
:when (= :symbol (:kind node))] id)
instances (if (seq instances) (sort-by str instances) [nil])]
(let [instances (->> (get-in clip [:timelines :main :nodes])
(filter (comp #{:symbol} :kind val))
;; By LABEL, not by id: ordering by a uuid is ordering at
;; random, and this list is read top to bottom by a person.
(sort-by (fn [[id _]] [(instance-label clip id) (str id)]))
(mapv key))
instances (if (seq instances) instances [nil])]
(vec (for [instance instances
[scope ids] [[:subject (:subjects clip)]
[:feature (:features clip)]
@ -70,7 +84,7 @@
(doall (for [[i [kind object-id]] (map-indexed vector owners)]
^{:key i} [:option {:value i}
(str (when-let [instance (nth (nth owners i) 2)]
(str (name instance) " / "))
(str (instance-label clip instance) " / "))
(name kind) " · " (name object-id))]))
[:option {:value 0} "no tracked objects"])] ]
(when instance
@ -223,6 +237,61 @@
(when project-seq (str " r" project-seq)) " · "))
project-status])]))
(defn- exporter []
(let [{:keys [timeline zoom isolate busy? done total status]} @(rf/subscribe [::export/state])
targets @(rf/subscribe [::export/targets])
{:keys [width height frames fps seconds poses]} @(rf/subscribe [::export/plan])]
[:section.export
[:div.row
[:label "export "
;; ONE SELECT over everything exportable: the clip, each symbol in its
;; library, and each placement on the stage. They are one list because they
;; are one kind of request — render this, alone — and a mode switch beside a
;; picker would only make the same choice twice.
;;
;; The option VALUE is `events/export/target-value`, not `(name id)`: a
;; symbol timeline is `:sym/face-8625` and a placement is a uuid, and
;; writing either through `name` loses what identifies it. That is the bug
;; where the id read back as `:face-8625`, matched no timeline, and the
;; export died inside re-frame's `:do-fx` with the button stuck on
;; "rendering…".
[:select {:value (export/target-value {:timeline (or timeline :main)
:isolate isolate})
:disabled busy?
:on-change #(rf/dispatch [::export/set-target
(export/target-id (.. % -target -value))])}
(doall
(for [{:keys [label] :as target} targets]
^{:key (export/target-value target)}
[:option {:value (export/target-value target)}
;; A placement is indented under the library above it, so that "the
;; drawing" and "that one on the stage" read as different things.
(str (when (:isolate target) "· ") label)]))]]
[:span.gap]
(doall
(for [z export/zooms]
^{:key z}
[:button {:class (when (= z zoom) "on") :disabled busy?
:on-click #(rf/dispatch [::export/set-zoom z])}
(str z "x")]))
[:button {:disabled busy? :on-click #(rf/dispatch [::export/start])}
(if busy? "rendering…" "frames + wav")]]
(when (and width frames)
[:div.readout
[:span (str width "x" height)]
[:span (str frames " frames @ " fps)]
[:span (str (.toFixed seconds 2) "s")]
;; Poses and frames are different numbers at a lower picture rate, and
;; showing both is how "exposure holds a drawing" stops being invisible:
;; the file is never short, the drawing is just held.
(when (not= poses frames) [:span (str poses " poses")])])
(when busy?
[:div.load-status (str "frame " done " / " total)])
(when (and status (not busy?)) [:div.load-status status])
[:p.note
"A lossless PNG sequence at an integer zoom, with the mixed audio, in one "
"zip. Import the sequence and the WAV as separate tracks."]]))
(defn- stage []
;; The canvas is the STAGE's size, and the stage is the clip's — not a constant
;; and not the footage's. Reactive, so selecting a clip of another size resizes
@ -241,6 +310,7 @@
[stage]
[audio]
[transport]
[exporter]
[controls]
[:p.note
"Upload a video, choose its footage, then load frames. Save the project to "