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

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

@ -48,6 +48,14 @@ and PUTs with ordinary CSRF protection — no endpoint in this app is exempt.
color: var(--fg); background: #1c1f2b; border: 1px solid #2b3040; color: var(--fg); background: #1c1f2b; border: 1px solid #2b3040;
font: inherit; max-width: 360px; } font: inherit; max-width: 360px; }
.load-status { margin-top: 6px; font-size: 12px; opacity: .75; } .load-status { margin-top: 6px; font-size: 12px; opacity: .75; }
.export { width: 640px; margin-top: 14px; padding-top: 12px;
border-top: 1px solid #2b3040; font-size: 12px; }
.export .row { display: flex; flex-wrap: wrap; gap: 6px; align-items: center; }
.export .gap { flex: 1; }
.export select { margin-left: 6px; padding: 3px 5px; color: var(--fg);
background: #1c1f2b; border: 1px solid #2b3040; font: inherit; }
.export .readout { margin-top: 7px; }
.export .note { margin: 7px 0 0; }
.controls { width: 640px; margin-top: 18px; padding-top: 12px; .controls { width: 640px; margin-top: 18px; padding-top: 12px;
border-top: 1px solid #2b3040; font-size: 12px; } border-top: 1px solid #2b3040; font-size: 12px; }
.controls select { margin-left: 8px; padding: 3px 5px; color: var(--fg); .controls select { margin-left: 8px; padding: 3px 5px; color: var(--fg);

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 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 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] (:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.node :as node])) [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) (let [channels (.-numberOfChannels buffer)
frames (.-length buffer) frames (.-length buffer)
rate (.-sampleRate buffer) rate (.-sampleRate buffer)
@ -35,7 +48,11 @@
(let [sample (* level (aget (get samples c) i))] (let [sample (* level (aget (get samples c) i))]
(.setInt16 view (+ 44 (* (+ (* i channels) c) 2)) (.setInt16 view (+ 44 (* (+ (* i channels) c) 2))
(js/Math.round (* 32767 (max -1 (min 1 sample)))) true)))) (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] (defn- source! [footage-id]
(-> (js/fetch (str "/api/footage/" footage-id)) (-> (js/fetch (str "/api/footage/" footage-id))
@ -73,10 +90,19 @@
(.linearRampToValueAtTime param (* factor v) (/ f fps)) (.linearRampToValueAtTime param (* factor v) (/ f fps))
(.setValueAtTime 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) (let [fps (:fps document)
frames (clip/frames document) frames (:frames (clip/timeline document tid))
tracks (filter #(= :audio (:kind %)) (vals (clip/nodes document))) tracks (tracks-of document tid)
output (js/OfflineAudioContext. output (js/OfflineAudioContext.
2 (js/Math.ceil (* (/ frames fps) 44100)) 44100)] 2 (js/Math.ceil (* (/ frames fps) 44100)) 44100)]
(doseq [track tracks] (doseq [track tracks]
@ -104,16 +130,41 @@
(.connect pan (.-destination output)) (.connect pan (.-destination output))
(.start sound (/ start (:fps document)) (/ (node/local-frame track start) fps)) (.start sound (/ start (:fps document)) (/ (node/local-frame track start) fps))
(.stop sound (/ end (:fps document)))))) (.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! (defn mix!
"Promise of a mixed WAV URL, or the original URL for a clip without audio "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." tracks. Each track can be trimmed and faded independently of its linked picture."
([document fallback-url] (mix! document fallback-url nil)) ([document fallback-url] (mix! document fallback-url nil))
([document fallback-url store] ([document fallback-url store]
(let [tracks (filter #(= :audio (:kind %)) (vals (clip/nodes document)))] (-> (buffer! document clip/root-id store)
(if (empty? tracks) (.then (fn [buffer] (if buffer (wav-url buffer) fallback-url))))))
(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))))))))

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

@ -89,6 +89,15 @@
;; how scrubbing becomes inspectable in re-frame-10x, and a collaborator's ;; 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 ;; playhead is a feature — putting it outside app-db puts it outside the
;; machinery that would share it. ;; 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 :playback {:frame 0
:playing? false :playing? false
:rate 1.0 :rate 1.0

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

@ -19,31 +19,53 @@
(+ (second base) (* dy (- (wave f 132) y0)))]])) (+ (second base) (* dy (- (wave f 132) y0)))]]))
:linear))) :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 (let [{:keys [name width height frames symbol instances audio scale]} layout
default-anchor (or (:anchor layout) default-anchor (or (:anchor layout)
[(/ (:width source) 2) (/ (:height source) 2)]) [(/ (:width source) 2) (/ (:height source) 2)])
original (get-in source [:timelines :main]) 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 nodes (into
{:root {:id :root :name "stage" :kind :group :z "a1"}} {: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)] (let [anchor (or anchor default-anchor)]
[id {:id id :name name :kind :symbol :of symbol [uuid {:id uuid :name name :kind :symbol :of symbol
:parent :root :z z :span span :parent :root :z z :span span
:time {:mode :map :at at :in in :rate 1} :time {:mode :map :at at :in in :rate 1}
:channels {[:xform :pos] (if drift :channels {[:xform :pos] (if drift
(position-track center anchor drift phase frames) (position-track center anchor drift phase frames)
(ch/framed (mapv - center anchor))) (ch/framed (mapv - center anchor)))
[:xform :anchor] {:animated? false :value anchor} [:xform :anchor] {:animated? false :value anchor}
[:xform :scale] scale}}])) [:xform :scale] scale}}]))
instances)) instances))
nodes (into nodes nodes (into nodes
(map (fn [{:keys [id linked-to z source span at in gain pan]}] (map (fn [{:keys [uuid linked-to z source span at in gain pan]}]
[id {:id id :kind :audio :parent :root :z z [uuid {:id uuid :kind :audio :parent :root :z z
:linked-to linked-to :source source :span span :linked-to (uuid-of uuid linked-to)
:time {:mode :map :at at :in in :rate 1} :source source :span span
:channels (cond-> {[:audio :gain] gain} :time {:mode :map :at at :in in :rate 1}
pan (assoc [:audio :pan] pan))}]) :channels (cond-> {[:audio :gain] gain}
pan (assoc [:audio :pan] pan))}])
audio))] audio))]
(cond-> (assoc source :name name :width width :height height (cond-> (assoc source :name name :width width :height height
:timelines {:main {:id :main :frames frames :nodes nodes} :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. ;; Audio placements are ordinary timeline nodes with channel parameters.
;; :linked-to is an editorial link; their spans and time maps are independent. ;; :linked-to is an editorial link; their spans and time maps are independent.
:audio :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"} :source {:footage "f8cace9e-4ad3-4796-973c-c62eeebe3d01"}
:span [0 280] :at 0 :in 0 :span [0 280] :at 0 :in 0
:gain {:animated? false :value 1.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"} :source {:footage "f8cace9e-4ad3-4796-973c-c62eeebe3d01"}
:span [48 260] :at 48 :in 0 :span [48 260] :at 48 :in 0
:gain {:animated? true :interp :linear :gain {:animated? true :interp :linear
@ -34,25 +36,42 @@
:pan {:animated? true :interp :linear :pan {:animated? true :interp :linear
:keys {48 -0.8, 90 -0.8, 130 0.7, 175 0.7, 220 -0.65, 259 0.65} :keys {48 -0.8, 90 -0.8, 130 0.7, 175 0.7, 220 -0.65, 259 0.65}
:over []}}] :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 :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 :span [0 280] :at 0 :in 0
:center [40 40] :drift [3 2] :phase 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 :span [48 280] :at 48 :in 0
:center [120 40] :drift [-3 2] :phase 17} :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 :span [24 280] :at 24 :in 0
:center [200 40] :drift [2 -3] :phase 31} :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 :span [72 280] :at 72 :in 0
:center [280 40] :drift [-2 -2] :phase 49} :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 :span [96 280] :at 96 :in 0
:center [70 135] :drift [3 -2] :phase 63} :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 :span [120 280] :at 120 :in 0
:center [160 135] :drift [-2 3] :phase 81} :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 :span [144 280] :at 144 :in 0
:center [250 135] :drift [2 2] :phase 107}]} :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 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 channel cursor or point buffer. The returned ops must be drawn before the next
frame, as with timeline/resolver." frame, as with timeline/resolver.
([clip store] (resolver clip store pal/index-of))
([clip store palette] `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] (letfn [(build [tid chain]
(when (some #{tid} chain) (when (some #{tid} chain)
(throw (ex-info "symbol timeline cycle" {:chain (conj chain tid)}))) (throw (ex-info "symbol timeline cycle" {:chain (conj chain tid)})))
@ -143,7 +151,7 @@
[])) []))
(when-let [op (get by-id id)] [op])))) (when-let [op (get by-id id)] [op]))))
ids))))))] ids))))))]
(build root-id [])))) (build root []))))
(defn problems (defn problems
"Human-readable reasons this clip will not evaluate or will not save. Empty "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}))) {:id id})))
(str/replace s "/" "~"))) (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 (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] [s]
(keyword (str/replace s "~" "/"))) (let [s (str/replace s "~" "/")]
(if (re-find uuid-segment s)
(uuid s)
(keyword s))))
(defn- prop->path (defn- prop->path
"A channel's property vector -> one path segment. `[:geom :pts]` is \"geom.pts\" "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)] (let [gaps (detect/fill-gaps @raw)]
(mark! "fill-gaps") (mark! "fill-gaps")
(assoc gaps :dimensions [w h] :crops @crops (assoc gaps :dimensions [w h] :crops @crops
:interior @inner))))))) :interior @inner :interior-settings take/knobs)))))))
(defn- build-clip [manifest detector (defn- build-clip [manifest detector
{:keys [dense detected dimensions interior missing first-real] {:keys [dense detected dimensions interior missing first-real]
@ -131,6 +131,7 @@
(-> (http/GET (str "/api/blocks/" key)) (-> (http/GET (str "/api/blocks/" key))
(.then (fn [block] (.then (fn [block]
(assoc track :interior (source/unpack-interior block take/knobs frames) (assoc track :interior (source/unpack-interior block take/knobs frames)
:interior-settings take/knobs
:interior-key key))) :interior-key key)))
(.catch (fn [error] (.catch (fn [error]
(if (= 404 (:status (ex-data error))) track (throw error))))))) (if (= 404 (:status (ex-data error))) track (throw error)))))))
@ -153,27 +154,37 @@
(saved-source! (:id (take/analysis-for manifest detector)) (saved-source! (:id (take/analysis-for manifest detector))
[(:width manifest) (:height manifest)])) [(:width manifest) (:height manifest)]))
(defn- measure-cached! [track] (defn measure-crops!
;; Older analyses may lack the optional interior block. Spread their one-time "Measure every retained crop's interior, ONE PER EVENT-LOOP TURN.
;; measurement over event-loop turns just like the fresh decode path.
(if (:interior track) 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) (js/Promise.resolve track)
(let [crops (:crops track) (let [crops (:crops track)
total (count crops) total (count crops)
interior (atom [])] interior (atom [])]
(js/Promise. (js/Promise.
(fn [resolve reject] (fn [resolve reject]
(letfn [(step [i] (letfn [(step [i]
(if (= i total) (if (= i total)
(resolve (assoc track :interior @interior)) (resolve (assoc track :interior @interior
(try :interior-settings settings))
(swap! interior conj (source/measure-crop take/knobs (nth crops i))) (try
(when (or (zero? i) (zero? (mod (inc i) 4)) (= (inc i) total)) (swap! interior conj (source/measure-crop settings (nth crops i)))
(rf/dispatch [::progress (when on-step (on-step (inc i) total))
(str "measuring " (inc i) "/" total)])) (js/setTimeout #(step (inc i)) 0)
(js/setTimeout #(step (inc i)) 0) (catch :default error (reject error)))))]
(catch :default error (reject error)))))] (step 0)))))))
(step 0)))))))
(rf/reg-fx (rf/reg-fx
::begin! ::begin!
@ -186,7 +197,13 @@
(.then (fn [track] (.then (fn [track]
(if track (if track
(do (rf/dispatch [::progress "reusing saved analysis…"]) (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] (.then (fn [measured]
(build-clip manifest detector measured))))) (build-clip manifest detector measured)))))
(do (rf/dispatch [::progress "loading MediaPipe…"]) (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-source (atom nil))
(defonce ^:private retained-interior (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] (defn- retained-interior! [analysis settings inputs]
(let [frames (count (:crops inputs)) (let [frames (count (:crops inputs))
block-key (source/interior-key analysis settings frames)] block-key (source/interior-key analysis settings frames)]
@ -238,7 +220,7 @@
:interior-key block-key))) :interior-key block-key)))
(.catch (fn [error] (.catch (fn [error]
(if (= 404 (:status (ex-data error))) (if (= 404 (:status (ex-data error)))
(-> (measure-crops! (dissoc inputs :interior) settings) (-> (footage/measure-crops! settings (dissoc inputs :interior) nil)
(.then (fn [measured] (.then (fn [measured]
(let [{:keys [key descriptor data]} (let [{:keys [key descriptor data]}
(source/interior-block analysis settings (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] [knob]
(get knob-roles 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 (defn block-descriptor
"The canonical text naming one dense block. "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.freeze :as freeze]
[arthur.flow.take :as take])) [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]) (let [f (get-in clip [:features fid])
mouth (first (for [[id peer] (:features clip) mouth (first (for [[id peer] (:features clip)
:when (and (= :mouth (:area peer)) :when (and (= :mouth (:area peer))
@ -17,6 +21,19 @@
(and (= :teeth (:area f)) mouth) (and (= :teeth (:area f)) mouth)
(assoc :aperture-cut (:aperture-cut (feature/effective-params clip 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] (defn- replace-feature [entry fragment fid]
(let [paths (for [id (get-in entry [:clip :features fid :nodes]) (let [paths (for [id (get-in entry [:clip :features fid :nodes])
[prop channel] (get-in fragment [:nodes id :channels]) [prop channel] (get-in fragment [:nodes id :channels])
@ -32,8 +49,9 @@
(update :store merge (:store fragment))))) (update :store merge (:store fragment)))))
(defn plan (defn plan
"The changed document and feature IDs an edit dirties. Also reports tier-2 "The changed document, the feature IDs an edit dirties, and the subject they
block roles from the existing address table for the debug UI." belong to. Also reports tier-2 block roles from the address table for the
debug UI."
[clip {:keys [scope id knob value]}] [clip {:keys [scope id knob value]}]
(let [area (get-in params/definitions [knob :area]) (let [area (get-in params/definitions [knob :area])
collection (case scope collection (case scope
@ -49,63 +67,71 @@
:knob knob :value value}))) :knob knob :value value})))
(let [changed (assoc-in clip [collection id :params knob] value) (let [changed (assoc-in clip [collection id :params knob] value)
subject (if (= scope :subject) id (:subject owner)) subject (if (= scope :subject) id (:subject owner))
members (case scope ;; Every feature of the subject is a candidate, not just the edited
:subject (for [[fid f] (:features clip) ;; object's own members, because a knob can reach a feature it does not
:when (= subject (:subject f))] fid) ;; belong to: `:aperture-cut` is a mouth setting that the TEETH read.
:feature [id] ;; `reads` is what narrows this back down, and it is the only thing
:group (:members owner)) ;; that does — no per-knob cases here, in either direction.
members (if (= knob :contour-avg) candidates (sort-by str (for [[fid f] (:features clip)
(remove #(= :teeth (get-in clip [:features % :area])) members) :when (= subject (:subject f))] fid))]
members)
members (if (= knob :aperture-cut)
(concat members (for [[fid f] (:features clip)
:when (and (= subject (:subject f))
(= :teeth (:area f)))] fid))
members)]
{:changed changed {:changed changed
:features (vec (filter #(not= (settings clip %) (settings changed %)) :subject subject
(distinct members))) :features (vec (filter #(not= (reads clip %) (reads changed %)) candidates))
:roles (address/invalidates knob)}))) :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 (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." teeth are dirty, retained pixel measurements. No IO or app-db here."
[{:keys [clip source-inputs] :as entry} edit] [{:keys [clip source-inputs] :as entry} edit]
(let [{changed :changed fids :features} (plan clip edit)] (when-not (:dense source-inputs)
(when-not (:dense source-inputs) (throw (ex-info "regeneration needs retained source landmarks" {})))
(throw (ex-info "regeneration needs retained source landmarks" {}))) (let [{:keys [changed subject features]} (plan clip edit)
(if (empty? fids) base-params (merge take/knobs
(assoc entry :clip changed) {:fps (:fps changed)
(let [base-params (merge take/knobs :aspect (get-in changed [:analysis :aspect])
{:fps (:fps clip) :analysis (:analysis changed)})
:aspect (get-in clip [:analysis :aspect]) ;; One conditioned anchor for the whole edit, and it is the SUBJECT's.
:analysis (:analysis clip)}) ;; `:anchor-avg` is a subject setting, so the shared upstream measurement
base (delay (take/anchor-base ;; is not read off whichever dirty feature happened to sort first — and
(merge base-params (settings changed (first fids))) ;; the head below does not need a feature to exist at all.
source-inputs)) anchor-params (merge base-params (params/for-area :subject)
entry (reduce (get-in changed [:subjects subject :params]))
(fn [entry fid] base (delay (take/anchor-base anchor-params source-inputs))]
(let [part-area (get-in changed [:features fid :area]) (cond-> (reduce (partial regenerate-feature base-params base source-inputs)
p (merge base-params (settings changed fid)) (assoc entry :clip changed) features)
_ (when (and (= part-area :teeth) (= :anchor-avg (:knob edit)) (regenerate-head anchor-params base))))
(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)))))
(defn change (defn change
"A take edits its root timeline. A stage edits the shared symbol timeline; "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)))] (if-let [symbol (some :timeline (vals (:features clip)))]
(let [original (:timelines clip) (let [original (:timelines clip)
take (assoc clip :timelines 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)] changed (change-take (assoc entry :clip take) edit)]
(assoc changed :clip (assoc changed :clip
(-> (:clip changed) (-> (:clip changed)
(assoc :timelines (assoc :timelines
(assoc original symbol (assoc original symbol
(assoc (get-in changed [:clip :timelines :main]) (assoc (get-in changed [:clip :timelines clip/root-id])
:id symbol)))))) :id symbol))))))
(change-take entry edit))) (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 measurement block. Everything after this boundary can run without PNGs or
MediaPipe. Mouth crops retain pixels for settings that change the measurement." MediaPipe. Mouth crops retain pixels for settings that change the measurement."
(:require [arthur.domain.landmarks :as lm] (:require [arthur.domain.landmarks :as lm]
[arthur.domain.params :as params]
[arthur.domain.wire :as wire] [arthur.domain.wire :as wire]
[arthur.flow.address :as address] [arthur.flow.address :as address]
[arthur.flow.measure.interior :as interior])) [arthur.flow.measure.interior :as interior]))
@ -90,8 +89,13 @@
{:role role :data data})) {:role role :data data}))
(defn pack (defn pack
"Dense landmarks, mask, crops and optional pixel measurements -> source blocks." "Dense landmarks, mask, crops and optional pixel measurements -> source blocks.
[analysis {:keys [dense detected crops interior]}]
`: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) (let [frames (count dense)
points (count (first dense))] points (count (first dense))]
(when-not (and (pos? frames) (pos? points) (when-not (and (pos? frames) (pos? points)
@ -119,16 +123,25 @@
(aset landmarks (+ base 2) z))) (aset landmarks (+ base 2) z)))
(when-let [crop (nth crops f)] (when-let [crop (nth crops f)]
(.set pixels (:data crop) (nth offsets f)))) (.set pixels (:data crop) (nth offsets f))))
(cond-> {"source/dense" (named "source/dense" analysis ["landmarks"] (cond-> {"source/dense"
{:type "float64" :frames frames :points points :stride (* 3 points)} (named "source/dense" analysis ["landmarks"]
landmarks) {:type "float64" :frames frames :points points
"source/detected" (named "source/detected" analysis ["detected"] :stride (* 3 points)}
{:type "uint8" :frames frames :stride 1} mask) landmarks)
"source/crops" (named "source/crops" analysis ["rgba"] "source/detected"
{:type "uint8" :frames frames :boxes boxes :offsets offsets} (named "source/detected" analysis ["detected"]
pixels)} {: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 (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] (defn wire-blocks [blocks]
(into-array (into-array

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

@ -9,6 +9,7 @@
[arthur.db :as db] [arthur.db :as db]
[arthur.domain.feature :as feature] [arthur.domain.feature :as feature]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.events.export :as export]
[arthur.events.footage :as footage] [arthur.events.footage :as footage]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
[arthur.events.project :as project] [arthur.events.project :as project]
@ -22,10 +23,23 @@
(defonce ^:private selected-owner (r/atom nil)) (defonce ^:private selected-owner (r/atom nil))
(defonce ^:private drafts (r/atom {})) (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] (defn- setting-owners [clip]
(let [instances (for [[id node] (get-in clip [:timelines :main :nodes]) (let [instances (->> (get-in clip [:timelines :main :nodes])
:when (= :symbol (:kind node))] id) (filter (comp #{:symbol} :kind val))
instances (if (seq instances) (sort-by str instances) [nil])] ;; 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 (vec (for [instance instances
[scope ids] [[:subject (:subjects clip)] [scope ids] [[:subject (:subjects clip)]
[:feature (:features clip)] [:feature (:features clip)]
@ -70,7 +84,7 @@
(doall (for [[i [kind object-id]] (map-indexed vector owners)] (doall (for [[i [kind object-id]] (map-indexed vector owners)]
^{:key i} [:option {:value i} ^{:key i} [:option {:value i}
(str (when-let [instance (nth (nth owners i) 2)] (str (when-let [instance (nth (nth owners i) 2)]
(str (name instance) " / ")) (str (instance-label clip instance) " / "))
(name kind) " · " (name object-id))])) (name kind) " · " (name object-id))]))
[:option {:value 0} "no tracked objects"])] ] [:option {:value 0} "no tracked objects"])] ]
(when instance (when instance
@ -223,6 +237,61 @@
(when project-seq (str " r" project-seq)) " · ")) (when project-seq (str " r" project-seq)) " · "))
project-status])])) 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 [] (defn- stage []
;; The canvas is the STAGE's size, and the stage is the clip's — not a constant ;; 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 ;; and not the footage's. Reactive, so selecting a clip of another size resizes
@ -241,6 +310,7 @@
[stage] [stage]
[audio] [audio]
[transport] [transport]
[exporter]
[controls] [controls]
[:p.note [:p.note
"Upload a video, choose its footage, then load frames. Save the project to " "Upload a video, choose its footage, then load frames. Save the project to "

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

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

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

@ -99,6 +99,36 @@
(is (thrown-with-msg? ExceptionInfo #"cannot contain ~" (is (thrown-with-msg? ExceptionInfo #"cannot contain ~"
(leaf/segment (keyword "a~b"))))) (leaf/segment (keyword "a~b")))))
(deftest a-placement-id-is-a-uuid-and-comes-back-one
;; A symbol instance is keyed by a uuid — `demo/stage/compose` has the argument
;; for why — and a leaf path is text, so reading one back has to return the id it
;; named and not a keyword that merely prints the same. A placement keyed
;; `:8f594d72-...` instead of `#uuid "8f594d72-..."` is a document that looks
;; right in a log and resolves nothing: `:linked-to` dangles and an export target
;; matches no node, with no error anywhere.
(let [u #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
c (one-timeline {u {:id u :kind :symbol :of :sym/face-8625 :parent nil
:z "a1" :name "8625 bottom left"}})
ls (leaf/leaves :c1 c)]
(is (contains? ls (str "clip/c1/timeline/main/node/" u))
"written plainly, with no sigil")
(is (= c (leaf/clip :c1 ls)))
(is (uuid? (first (keys (get-in (leaf/clip :c1 ls) [:timelines :main :nodes])))))))
(deftest only-a-whole-canonical-uuid-reads-as-one
;; The id encoding decides by SHAPE, so the boundaries of that shape are the
;; whole of the rule: an id that merely CONTAINS a uuid, or is one character off,
;; or is upper-case, is an ordinary keyword and has to stay one.
(testing "these are uuids"
(is (uuid? (leaf/unsegment "8f594d72-a97f-4a32-82fd-08d1670a2218"))))
(testing "and these are not"
(doseq [s ["face-8f594d72-a97f-4a32-82fd-08d1670a2218"
"8f594d72-a97f-4a32-82fd-08d1670a2218-left"
"8f594d72-a97f-4a32-82fd-08d1670a221"
"8F594D72-A97F-4A32-82FD-08D1670A2218"
"not-a-uuid" "main"]]
(is (keyword? (leaf/unsegment s)) (str s " must stay a keyword")))))
(deftest another-clips-leaves-are-ignored-rather-than-merged (deftest another-clips-leaves-are-ignored-rather-than-merged
;; A project's whole leaf map can be handed in for one clip, which is what makes ;; A project's whole leaf map can be handed in for one clip, which is what makes
;; a two-clip project one fetch. ;; a two-clip project one fetch.

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

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

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

@ -1,5 +1,5 @@
(ns arthur.domain.symbol-test (ns arthur.domain.symbol-test
(:require [cljs.test :refer [deftest is]] (:require [cljs.test :refer [deftest is testing]]
[arthur.demo.stage :as stage] [arthur.demo.stage :as stage]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
@ -40,21 +40,48 @@
(is (= [[[:right :mark] 150]] (at 5))) (is (= [[[:right :mark] 150]] (at 5)))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document)))))) (is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(defn- uuid-of
"The uuid the layout authors for the placement whose handle is `id`.
Read out of `stage/layout` rather than written here as a literal: what this test
is about is the mapping `compose` performs, and nine copied uuids would assert
that someone copied them correctly."
[id]
(or (->> (concat (:instances stage/layout) (:audio stage/layout))
(some (fn [p] (when (= id (:id p)) (:uuid p)))))
(throw (ex-info "no such placement in the layout" {:id id}))))
(defn- placement
"The composed node for the placement the layout calls `id`."
[document id]
(get-in document [:timelines :main :nodes (uuid-of id)]))
(deftest stage-fixture-keeps-source-as-one-symbol (deftest stage-fixture-keeps-source-as-one-symbol
(let [document (stage/compose source)] (let [document (stage/compose source)]
(is (empty? (clip/problems document))) (is (empty? (clip/problems document)))
(is (= #{:main :sym/face-8625} (set (keys (:timelines document))))) (is (= #{:main :sym/face-8625} (set (keys (:timelines document)))))
(is (= :sym/face-8625 (get-in document [:timelines :main :nodes :left :of]))) (is (= :sym/face-8625 (:of (placement document :left))))
(is (= :sym/face-8625 (get-in document [:timelines :main :nodes :right :of]))) (is (= :sym/face-8625 (:of (placement document :right))))
(testing "every placement is keyed by its own uuid"
;; The identity change: seven placements of one drawing are seven things,
;; and each is named by something that means only itself. Sharing a key, or
;; keying by a description of where a thing sits, is what this rules out.
(let [symbols (filter (comp #{:symbol} :kind val)
(get-in document [:timelines :main :nodes]))]
(is (= 7 (count symbols)))
(is (every? uuid? (map key symbols)))
(is (= 7 (count (distinct (map key symbols)))))
(testing "and each still says which drawing it plays and what to call it"
(is (every? #(= :sym/face-8625 (:of (val %))) symbols))
(is (every? #(string? (:name (val %))) symbols))
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
(is (= 7 (count (filter #(= :symbol (:kind %)) (is (= 7 (count (filter #(= :symbol (:kind %))
(vals (get-in document [:timelines :main :nodes])))))) (vals (get-in document [:timelines :main :nodes]))))))
(is (= [48 280] (get-in document [:timelines :main :nodes :right :span]))) (is (= [48 280] (:span (placement document :right))))
(let [scale (get-in document [:timelines :main :nodes :left (let [left (placement document :left)
:channels [:xform :scale]]) scale (get-in left [:channels [:xform :scale]])
anchor (get-in document [:timelines :main :nodes :left anchor (get-in left [:channels [:xform :anchor] :value])
:channels [:xform :anchor] :value]) pos (get-in left [:channels [:xform :pos]])
pos (get-in document [:timelines :main :nodes :left
:channels [:xform :pos]])
start-pos (ch/value-at pos 0)] start-pos (ch/value-at pos 0)]
(is (= [160 100] anchor) "the source center becomes a stored pivot") (is (= [160 100] anchor) "the source center becomes a stored pivot")
(is (= [-120 -60] start-pos)) (is (= [-120 -60] start-pos))
@ -68,12 +95,17 @@
(node/apply-pt! out 0 m 160 100) (node/apply-pt! out 0 m 160 100)
(is (= [40 40] [(aget out 0) (aget out 1)]) (is (= [40 40] [(aget out 0) (aget out 1)])
"the face center stays put while it scales")))) "the face center stays put while it scales"))))
(is (= :right (get-in document [:timelines :main :nodes :voice-right :linked-to]))) (testing "the editorial link resolves to the placement's uuid"
(is (= [48 260] (get-in document [:timelines :main :nodes :voice-right :span]))) ;; The EDN names `:right`; the document must carry the identity, or the link
;; dangles the moment anything is renamed. `clip/problems` above checks it
;; resolves to a node at all; this checks it resolves to the RIGHT one.
(is (= (uuid-of :right) (:linked-to (placement document :voice-right))))
(is (uuid? (:linked-to (placement document :voice-right)))))
(is (= [48 260] (:span (placement document :voice-right))))
(is (= 0.5 (ch/value-at (is (= 0.5 (ch/value-at
(get-in document [:timelines :main :nodes :voice-right (get-in (placement document :voice-right)
:channels [:audio :gain]]) 54))) [:channels [:audio :gain]]) 54)))
(is (< -0.8 (ch/value-at (is (< -0.8 (ch/value-at
(get-in document [:timelines :main :nodes :voice-right (get-in (placement document :voice-right)
:channels [:audio :pan]]) 110) 0.7)) [:channels [:audio :pan]]) 110) 0.7))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document)))))) (is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))

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

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

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

@ -0,0 +1,91 @@
(ns arthur.events.export-test
"The picker's round trip, which is the whole of a bug that read as a hung tab.
An export target is a timeline or a placement inside one. A symbol timeline's id
is NAMESPACED (`:sym/face-8625`) and a placement's is a UUID, and the panel puts
both into `<option value>`s and reads them back out of a change event. Writing
that value with `name` drops the `sym`, the id comes back `:face-8625`, it
matches no key in `:timelines`, and `export/run!` throws from inside re-frame's
`:do-fx` where nothing catches it: `:busy?` latches on and the readout sits at
\"frame 0 /\" forever with nothing in the status line.
So the pair is asserted directly, on both kinds, because `name` and `keyword`
are individually reasonable-looking and only wrong together."
(:require [cljs.test :refer [deftest is testing]]
[arthur.events.export :as export]))
(def ^:private a-uuid #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218")
(deftest every-kind-of-target-survives-the-round-trip
(doseq [t [{:timeline :main}
{:timeline :sym/face-8625}
{:timeline :main :isolate a-uuid}
{:timeline :sym/face-8625 :isolate a-uuid}]]
(let [back (export/target-id (export/target-value t))]
(is (= (:timeline t) (:timeline back))
(str (pr-str t) " -> " (pr-str (export/target-value t))))
(is (= (:isolate t) (:isolate back)))
(testing "and a placement comes back a uuid, not a string or a keyword"
(when (:isolate t)
(is (uuid? (:isolate back))))))))
(deftest the-value-keeps-the-namespace-and-marks-the-two-kinds
;; Spelled out, because these are the strings that end up in the DOM.
(is (= "t:main" (export/target-value {:timeline :main})))
(is (= "t:sym/face-8625" (export/target-value {:timeline :sym/face-8625})))
(is (= (str "n:main:" a-uuid)
(export/target-value {:timeline :main :isolate a-uuid}))))
(deftest a-whole-timeline-has-no-isolate
;; Switching from a placement back to the clip must clear it, or the new target
;; would still be filtered down to one node that may not even be in it.
(is (nil? (:isolate (export/target-id "t:main")))))
(deftest the-old-encoding-is-the-bug
;; A guard against someone "simplifying" this back to `name`. `name` is lossy on
;; exactly the ids the stage produces, and this states what that costs.
(is (not= :sym/face-8625 (keyword (name :sym/face-8625)))
"name/keyword loses the namespace, which is what broke the export")
(is (thrown? js/Error (name a-uuid))
"and a placement's id is not something `name` can take at all"))
;; ---- what the picker offers ----
(def ^:private clip
"A clip with one symbol in its library, placed twice, plus a decoy: a node that
is not a symbol must not show up as a face."
{:fps 30 :width 320 :height 200
:timelines
{:main {:frames 280
:nodes {:root {:id :root :kind :group :z "a1"}
#uuid "22222222-2222-4222-8222-222222222222"
{:id #uuid "22222222-2222-4222-8222-222222222222"
:kind :symbol :of :sym/face :parent :root :z "a2"
:name "8625 right"}
#uuid "11111111-1111-4111-8111-111111111111"
{:id #uuid "11111111-1111-4111-8111-111111111111"
:kind :symbol :of :sym/face :parent :root :z "a1"
:name "8625 left"}
:a-rect {:id :a-rect :kind :rect :parent :root :z "a3"}}}
:sym/face {:frames 40 :nodes {:root {:id :root :kind :group :z "a1"}}}}})
(deftest the-picker-offers-the-clip-the-drawing-and-every-placement
(let [ts (export/targets clip)]
(is (= ["main (the clip)" "face" "8625 left" "8625 right"] (mapv :label ts))
"the clip, then the library, then the placements")
(testing "the placements isolate a node on :main and the library ones do not"
(is (= [nil nil] (mapv :isolate (take 2 ts))))
(is (every? uuid? (mapv :isolate (drop 2 ts))))
(is (every? #(= :main (:timeline %)) (drop 2 ts))))
(testing "ordered by label, because a uuid sorts at random"
(is (= ["8625 left" "8625 right"] (mapv :label (drop 2 ts)))))
(testing "and a node that is not a symbol is not a placement"
(is (not-any? #{"a-rect"} (map :label ts))))))
(deftest every-offered-target-round-trips
;; The picker and the encoding asserted against each other, so neither can drift
;; into offering something that cannot be selected.
(doseq [t (export/targets clip)]
(let [norm #(merge {:isolate nil} (select-keys % [:timeline :isolate]))
back (export/target-id (export/target-value t))]
(is (= (norm t) (norm back)) (pr-str t)))))

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

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

298
frontend/test/arthur/export_test.cljs Normal file
View file

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

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

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

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

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

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

@ -1,5 +1,5 @@
(ns arthur.flow.source-test (ns arthur.flow.source-test
(:require [cljs.test :refer [deftest is]] (:require [cljs.test :refer [deftest is testing]]
[arthur.domain.params :as params] [arthur.domain.params :as params]
[arthur.domain.wire :as wire] [arthur.domain.wire :as wire]
[arthur.flow.source :as source])) [arthur.flow.source :as source]))
@ -41,8 +41,15 @@
(deftest fresh-source-includes-its-pixel-measurement-block (deftest fresh-source-includes-its-pixel-measurement-block
(let [face (vec (repeat 478 {:x 0.25 :y 0.5 :z -0.125})) (let [face (vec (repeat 478 {:x 0.25 :y 0.5 :z -0.125}))
input {:dense [face] :detected [false] :crops [nil] input {:dense [face] :detected [false] :crops [nil]
:interior [{:contour nil :contrast 0 :area 0}]} :interior [{:contour nil :contrast 0 :area 0}]
:interior-settings params/defaults}
blocks (source/pack "sha256:analysis" input)] blocks (source/pack "sha256:analysis" input)]
(is (contains? blocks "source/interior")) (is (contains? blocks "source/interior"))
(is (= 4 (.-length (source/upload-blocks blocks)))) (is (= 4 (.-length (source/upload-blocks blocks))))
(is (= 3 (count source/roles))))) (is (= 3 (count source/roles)))
(testing "and cannot be packed without the settings it was measured at"
;; The block is addressed BY those knobs. Defaulting them would name it
;; after settings its bytes did not come from, which is a key that lies.
(is (thrown-with-msg?
ExceptionInfo #"needs the settings"
(source/pack "sha256:analysis" (dissoc input :interior-settings)))))))

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

@ -404,8 +404,13 @@ async function main() {
check(stageLoaded !== null, 'the 8625 stage is ready', stageLoaded ?? (await page.eval(STATUS))); check(stageLoaded !== null, 'the 8625 stage is ready', stageLoaded ?? (await page.eval(STATUS)));
const eyeSelected = await page.eval(`(() => { const eyeSelected = await page.eval(`(() => {
const select = document.querySelector('.controls select'); const select = document.querySelector('.controls select');
// The instance prefix is the placement's NAME ("8625 left"), not its id:
// a placement is keyed by a uuid now, and a uuid is not something to show
// anyone. So this matches the feature and requires SOME instance prefix,
// rather than pinning the label a rename is free to change.
const option = [...select.options] const option = [...select.options]
.find(o => o.textContent.trim() === 'left / feature · eye-r'); .find(o => o.textContent.trim().endsWith('/ feature · eye-r')
&& o.textContent.includes(' / '));
if (!option) return false; if (!option) return false;
select.value = option.value; select.value = option.value;
select.dispatchEvent(new Event('change', { bubbles: true })); select.dispatchEvent(new Event('change', { bubbles: true }));
@ -417,6 +422,12 @@ async function main() {
const row = [...document.querySelectorAll('.control-row')] const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.textContent === 'iris-size'); .find(row => row.querySelector('span')?.textContent === 'iris-size');
if (!row) return null; if (!row) return null;
// Scrolled into view FIRST, because the click below is dispatched at
// viewport coordinates: a control panel that has grown past the fold
// otherwise reports a y outside the window, the click lands on nothing,
// and the failure reads as "regeneration is broken" rather than "the
// slider was off-screen". Which is exactly what it read as once.
row.scrollIntoView({ block: 'center' });
const r = row.querySelector('input').getBoundingClientRect(); const r = row.querySelector('input').getBoundingClientRect();
return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 }; return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 };
})()`); })()`);
@ -455,6 +466,12 @@ async function main() {
const row = [...document.querySelectorAll('.control-row')] const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.textContent === 'anchor-avg'); .find(row => row.querySelector('span')?.textContent === 'anchor-avg');
if (!row) return null; if (!row) return null;
// Scrolled into view FIRST, because the click below is dispatched at
// viewport coordinates: a control panel that has grown past the fold
// otherwise reports a y outside the window, the click lands on nothing,
// and the failure reads as "regeneration is broken" rather than "the
// slider was off-screen". Which is exactly what it read as once.
row.scrollIntoView({ block: 'center' });
const r = row.querySelector('input').getBoundingClientRect(); const r = row.querySelector('input').getBoundingClientRect();
return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 }; return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 };
})()`); })()`);
@ -485,7 +502,8 @@ async function main() {
const teethSelected = await page.eval(`(() => { const teethSelected = await page.eval(`(() => {
const select = document.querySelector('.controls select'); const select = document.querySelector('.controls select');
const option = [...select.options] const option = [...select.options]
.find(o => o.textContent.trim() === 'left / feature · teeth'); .find(o => o.textContent.trim().endsWith('/ feature · teeth')
&& o.textContent.includes(' / '));
if (!option) return false; if (!option) return false;
select.value = option.value; select.value = option.value;
select.dispatchEvent(new Event('change', { bubbles: true })); select.dispatchEvent(new Event('change', { bubbles: true }));
@ -498,6 +516,12 @@ async function main() {
const row = [...document.querySelectorAll('.control-row')] const row = [...document.querySelectorAll('.control-row')]
.find(row => row.querySelector('span')?.textContent === 'cavity-erode'); .find(row => row.querySelector('span')?.textContent === 'cavity-erode');
if (!row) return null; if (!row) return null;
// Scrolled into view FIRST, because the click below is dispatched at
// viewport coordinates: a control panel that has grown past the fold
// otherwise reports a y outside the window, the click lands on nothing,
// and the failure reads as "regeneration is broken" rather than "the
// slider was off-screen". Which is exactly what it read as once.
row.scrollIntoView({ block: 'center' });
const r = row.querySelector('input').getBoundingClientRect(); const r = row.querySelector('input').getBoundingClientRect();
return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 }; return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 };
})()`); })()`);