Add PNG sequence export and uuid-keyed stage placements
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_016JBYKfeMPQTK1WNcgcw41o
This commit is contained in:
Olive Vaughn
parent
3058b9a5f2
commit
e22ee600b9
31 changed files with 2642 additions and 178 deletions
50
frontend/test/arthur/domain/crc32_test.cljs
Normal file
50
frontend/test/arthur/domain/crc32_test.cljs
Normal 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))))
|
||||
|
|
@ -99,6 +99,36 @@
|
|||
(is (thrown-with-msg? ExceptionInfo #"cannot contain ~"
|
||||
(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
|
||||
;; A project's whole leaf map can be handed in for one clip, which is what makes
|
||||
;; a two-clip project one fetch.
|
||||
|
|
|
|||
227
frontend/test/arthur/domain/png_test.cljs
Normal file
227
frontend/test/arthur/domain/png_test.cljs
Normal 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)))))))
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
(ns arthur.domain.symbol-test
|
||||
(:require [cljs.test :refer [deftest is]]
|
||||
(:require [cljs.test :refer [deftest is testing]]
|
||||
[arthur.demo.stage :as stage]
|
||||
[arthur.domain.channel :as ch]
|
||||
[arthur.domain.clip :as clip]
|
||||
|
|
@ -40,21 +40,48 @@
|
|||
(is (= [[[:right :mark] 150]] (at 5)))
|
||||
(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
|
||||
(let [document (stage/compose source)]
|
||||
(is (empty? (clip/problems 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 (get-in document [:timelines :main :nodes :right :of])))
|
||||
(is (= :sym/face-8625 (:of (placement document :left))))
|
||||
(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 %))
|
||||
(vals (get-in document [:timelines :main :nodes]))))))
|
||||
(is (= [48 280] (get-in document [:timelines :main :nodes :right :span])))
|
||||
(let [scale (get-in document [:timelines :main :nodes :left
|
||||
:channels [:xform :scale]])
|
||||
anchor (get-in document [:timelines :main :nodes :left
|
||||
:channels [:xform :anchor] :value])
|
||||
pos (get-in document [:timelines :main :nodes :left
|
||||
:channels [:xform :pos]])
|
||||
(is (= [48 280] (:span (placement document :right))))
|
||||
(let [left (placement document :left)
|
||||
scale (get-in left [:channels [:xform :scale]])
|
||||
anchor (get-in left [:channels [:xform :anchor] :value])
|
||||
pos (get-in left [:channels [:xform :pos]])
|
||||
start-pos (ch/value-at pos 0)]
|
||||
(is (= [160 100] anchor) "the source center becomes a stored pivot")
|
||||
(is (= [-120 -60] start-pos))
|
||||
|
|
@ -68,12 +95,17 @@
|
|||
(node/apply-pt! out 0 m 160 100)
|
||||
(is (= [40 40] [(aget out 0) (aget out 1)])
|
||||
"the face center stays put while it scales"))))
|
||||
(is (= :right (get-in document [:timelines :main :nodes :voice-right :linked-to])))
|
||||
(is (= [48 260] (get-in document [:timelines :main :nodes :voice-right :span])))
|
||||
(testing "the editorial link resolves to the placement's uuid"
|
||||
;; 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
|
||||
(get-in document [:timelines :main :nodes :voice-right
|
||||
:channels [:audio :gain]]) 54)))
|
||||
(get-in (placement document :voice-right)
|
||||
[:channels [:audio :gain]]) 54)))
|
||||
(is (< -0.8 (ch/value-at
|
||||
(get-in document [:timelines :main :nodes :voice-right
|
||||
:channels [:audio :pan]]) 110) 0.7))
|
||||
(get-in (placement document :voice-right)
|
||||
[:channels [:audio :pan]]) 110) 0.7))
|
||||
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
|
||||
|
|
|
|||
164
frontend/test/arthur/domain/zip_test.cljs
Normal file
164
frontend/test/arthur/domain/zip_test.cljs
Normal 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
91
frontend/test/arthur/events/export_test.cljs
Normal 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
214
frontend/test/arthur/export/frames_test.cljs
Normal 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
298
frontend/test/arthur/export_test.cljs
Normal 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,4 +1,5 @@
|
|||
(ns arthur.flow.measure.mouth-test
|
||||
(:refer-clojure :exclude [spread])
|
||||
(:require [cljs.test :refer [deftest is testing]]
|
||||
[arthur.domain.landmarks :as lm]
|
||||
[arthur.domain.ring :as ring]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,12 @@
|
|||
(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.flow.address :as address]
|
||||
[arthur.flow.freeze :as freeze]
|
||||
[arthur.flow.regenerate :as regenerate]
|
||||
[arthur.flow.take :as take]
|
||||
[arthur.synth :as synth]))
|
||||
|
|
@ -99,3 +104,168 @@
|
|||
(is (= (:clip after) (:clip loaded)))
|
||||
(is (= (channel after :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")))))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
(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.wire :as wire]
|
||||
[arthur.flow.source :as source]))
|
||||
|
|
@ -41,8 +41,15 @@
|
|||
(deftest fresh-source-includes-its-pixel-measurement-block
|
||||
(let [face (vec (repeat 478 {:x 0.25 :y 0.5 :z -0.125}))
|
||||
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)]
|
||||
(is (contains? blocks "source/interior"))
|
||||
(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)))))))
|
||||
|
|
|
|||
|
|
@ -404,8 +404,13 @@ async function main() {
|
|||
check(stageLoaded !== null, 'the 8625 stage is ready', stageLoaded ?? (await page.eval(STATUS)));
|
||||
const eyeSelected = await page.eval(`(() => {
|
||||
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]
|
||||
.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;
|
||||
select.value = option.value;
|
||||
select.dispatchEvent(new Event('change', { bubbles: true }));
|
||||
|
|
@ -417,6 +422,12 @@ async function main() {
|
|||
const row = [...document.querySelectorAll('.control-row')]
|
||||
.find(row => row.querySelector('span')?.textContent === 'iris-size');
|
||||
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();
|
||||
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')]
|
||||
.find(row => row.querySelector('span')?.textContent === 'anchor-avg');
|
||||
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();
|
||||
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 select = document.querySelector('.controls select');
|
||||
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;
|
||||
select.value = option.value;
|
||||
select.dispatchEvent(new Event('change', { bubbles: true }));
|
||||
|
|
@ -498,6 +516,12 @@ async function main() {
|
|||
const row = [...document.querySelectorAll('.control-row')]
|
||||
.find(row => row.querySelector('span')?.textContent === 'cavity-erode');
|
||||
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();
|
||||
return { x: r.x + r.width * 0.9, y: r.y + r.height / 2 };
|
||||
})()`);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue