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

Make every caller say what it means: no defaulted arities

Browse source 
Pre-alpha. Nothing here is owed a call shape it used to have.

Twelve convenience arities deleted, and the only reason to single any of
them out is that one of them was a live bug: `channel/value-at`'s `([ch f])`
filled in a nil tier-2 store, so a caller could omit it, read correctly for
every channel that happened not to be dense, and throw the first time one
was. That is the iris crash, and threading the store through `gesture/values`
last commit fixed the symptom while leaving the trapdoor open. Deleting the
arity found `node/toggle-key` standing on it too — the inspector's stopwatch
on a measured channel, the same throw, never reported.

Gone, and what the compiler then made explicit at each site:

  channel/value-at, cursor, dense-at   the store, and `nil` where a caller
                                       genuinely has none and means it
  channel/keyed                        `:hold`, which is a cut rather than a
                                       tween and not a thing to leave implied
  symbol/resolver (4), eval-frame (3)  store, palette, pose-tracks, opts
  clip/resolver                        opts
  mix/buffer!, store/install!          dead: no caller used the short form

`pick/local-bounds` goes the same way — it was `bounds-of` with the closure
thrown away, so callers build the closure and call it.

Every site was found by shadow-cljs `:fn-arity` rather than by grep, which is
the argument for the change: 90-odd call sites, and the compiler listed all of
them. BUILD BOTH TARGETS — the last three only appear in `:app`, since `:test`
compiles what the tests reach and the inspector, the pool drag and the vertex
overlay are not that.

Left alone, because an argument with a default is not the same thing as a
shim: genuine optionality like `fx/http`'s body, `geom`'s iteration count,
`zip`'s injected clock.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-09-30 12:10:22 -04:00
parent 11093079de
commit ee66680a0c
30 changed files with 224 additions and 217 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -147,14 +147,13 @@
The raw product. `mix!` packages it as a WAV URL for the transport and 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 `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." it is, which is why this is the function the others are written in terms of."
([document sid] (buffer! document sid nil)) [document sid store]
([document sid store]
(let [tracks (tracks-of document sid)] (let [tracks (tracks-of document sid)]
(if (empty? tracks) (if (empty? tracks)
(js/Promise.resolve nil) (js/Promise.resolve nil)
(-> (js/Promise.all (-> (js/Promise.all
(into-array (map source! (distinct (map :source tracks))))) (into-array (map source! (distinct (map :source tracks)))))
(.then (fn [pairs] (render! document sid (into {} (array-seq pairs)) store)))))))) (.then (fn [pairs] (render! document sid (into {} (array-seq pairs)) store)))))))
(defn decode! (defn decode!
"Promise of the `AudioBuffer` behind a URL. What a clip whose audio is a plain "Promise of the `AudioBuffer` behind a URL. What a clip whose audio is a plain

3
frontend/src/arthur/demo.cljs
View file

@ -6,6 +6,7 @@
validates would not be the one that renders, and the model would be validated validates would not be the one that renders, and the model would be validated
against a scene nobody ever looked at." against a scene nobody ever looked at."
(:require [arthur.domain.clip :as domain-clip] (:require [arthur.domain.clip :as domain-clip]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[cljs.reader :as reader] [cljs.reader :as reader]
[shadow.resource :as rc])) [shadow.resource :as rc]))
@ -25,4 +26,4 @@
"Draw ops for one frame, via the specification path. The page uses "Draw ops for one frame, via the specification path. The page uses
`symbol/resolver` instead; this is here for the REPL." `symbol/resolver` instead; this is here for the REPL."
[f] [f]
(symbol/eval-frame main f)) (symbol/eval-frame main f nil pal/index-of nil nil))

40
frontend/src/arthur/domain/channel.cljs
View file

@ -68,8 +68,11 @@
(defn framed [v] {:animated? false :value v}) (defn framed [v] {:animated? false :value v})
(defn keyed (defn keyed
([ks] (keyed ks :hold)) "A channel of keys, and how each one leads to the next. `interp` is an
([ks interp] {:animated? true :interp interp :keys ks :over []})) argument, never a default: `:hold` and `:linear` are the difference between a
cut and a tween, which is the whole content of the channel."
[ks interp]
{:animated? true :interp interp :keys ks :over []})
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
@ -147,9 +150,9 @@
Decoding costs the view. `out` is a stride-sized destination the caller owns — Decoding costs the view. `out` is a stride-sized destination the caller owns —
`cursor` allocates one per channel — because a copy per node per frame is the `cursor` allocates one per channel — because a copy per node per frame is the
allocation this whole model is arranged to avoid; passing nil allocates, which allocation this whole model is arranged to avoid; passing nil allocates, which
is what `value-at`, the specification, does." is what `value-at`, the specification, does — and it says so by passing nil,
([blk f st] (dense-at blk f st nil)) because there is no arity here that decides it for a caller."
([{:keys [store offset stride scale] nf :frames} f st out] [{:keys [store offset stride scale] nf :frames} f st out]
(let [{:keys [data state]} (get st store)] (let [{:keys [data state]} (get st store)]
(when (nil? data) (when (nil? data)
(throw (ex-info "dense channel's store key is not in the store" (throw (ex-info "dense channel's store key is not in the store"
@ -164,7 +167,7 @@
:else (let [dst (or out (js/Float64Array. stride))] :else (let [dst (or out (js/Float64Array. stride))]
(dotimes [k stride] (dotimes [k stride]
(aset dst k (/ (aget data (+ o k)) scale))) (aset dst k (/ (aget data (+ o k)) scale)))
dst)))))))) dst)))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the specification ;; the specification
@ -201,17 +204,23 @@
(defn value-at (defn value-at
"Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and "Sample a channel at frame f. THE SPECIFICATION — correct, allocating, and
O(n) in the keys. `cursor`/`sample!` is what playback uses." O(n) in the keys. `cursor`/`sample!` is what playback uses.
([ch f] (value-at ch f nil))
([ch f store] `store` IS AN ARGUMENT, NEVER A DEFAULT. A dense channel cannot be read
without the tier-2 store it names, and an arity that filled in nil let a
caller omit it, read correctly for every channel that happened not to be
dense, and throw the first time a selection landed on one that was. That is
how `gesture/values` took the stage down on an iris. A caller with no store
says `nil` and means it."
[ch f store]
(check-unimplemented! ch) (check-unimplemented! ch)
(cond (cond
(not (:animated? ch)) (:value ch) (not (:animated? ch)) (:value ch)
(:dense ch) (dense-at (:dense ch) f store) (:dense ch) (dense-at (:dense ch) f store nil)
(:keys ch) (let [ks (:keys ch)] (:keys ch) (let [ks (:keys ch)]
(if (empty? ks) absent (keyed-at ch f))) (if (empty? ks) absent (keyed-at ch f)))
:else :else
(throw (ex-info "animated channel has neither :keys nor :dense" {:channel ch}))))) (throw (ex-info "animated channel has neither :keys nor :dense" {:channel ch}))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the playback path ;; the playback path
@ -244,9 +253,10 @@
needs, for the same reason the resolver owns one point buffer per node. needs, for the same reason the resolver owns one point buffer per node.
Only a wide fixed-point block gets a buffer: a stride-1 block decodes to a Only a wide fixed-point block gets a buffer: a stride-1 block decodes to a
number and a block with no `:scale` is handed back as a view." number and a block with no `:scale` is handed back as a view.
([ch] (cursor ch nil))
([ch store] `store` is an argument for the reason it is one on `value-at`."
[ch store]
(check-unimplemented! ch) (check-unimplemented! ch)
(let [d (:dense ch)] (let [d (:dense ch)]
(->Cursor ch (->Cursor ch
@ -254,7 +264,7 @@
store store
(when (and d (:scale d) (> (:stride d) 1)) (when (and d (:scale d) (> (:stride d) 1))
(js/Float64Array. (:stride d))) (js/Float64Array. (:stride d)))
0)))) 0)))
(defn sample! (defn sample!
"Value of the cursor's channel at f. O(1) when f is at or one key past where "Value of the cursor's channel at f. O(1) when f is at or one key past where

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

@ -174,8 +174,7 @@
own frame. Nil for a node that was not on that frame. It is how something own frame. Nil for a node that was not on that frame. It is how something
drawn beside the picture, like a tracing photo, rides a node inside it without drawn beside the picture, like a tracing photo, rides a node inside it without
resolving anything a second time." resolving anything a second time."
([clip store palette sid] (resolver clip store palette sid nil)) [clip store palette sid {:keys [picture-fps] :as opts}]
([clip store palette sid {:keys [picture-fps] :as opts}]
(letfn [(build [sid chain pose-tracks] (letfn [(build [sid chain pose-tracks]
(when (some #{sid} chain) (when (some #{sid} chain)
(throw (ex-info "symbol cycle" {:chain (conj chain sid)}))) (throw (ex-info "symbol cycle" {:chain (conj chain sid)})))
@ -230,7 +229,7 @@
(when (contains? @entered id) (when (contains? @entered id)
(symbol/frame-of (get children id) (vec more))) (symbol/frame-of (get children id) (vec more)))
(symbol/frame-of own id))))))] (symbol/frame-of own id))))))]
(build sid [] nil)))) (build sid [] nil)))
(defn center (defn center
"The middle of everything symbol `sid` draws, over all its frames, in its own "The middle of everything symbol `sid` draws, over all its frames, in its own
@ -244,7 +243,7 @@
Effects' anchor point are set once and left. A symbol that grows later keeps Effects' anchor point are set once and left. A symbol that grows later keeps
its instances' pivots where they were, so nothing on screen moves." its instances' pivots where they were, so nothing on screen moves."
[clip store sid] [clip store sid]
(let [resolve (resolver clip store pal/index-of sid) (let [resolve (resolver clip store pal/index-of sid nil)
bounds (fn [[x0 y0 x1 y1 :as b] x y] bounds (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y])) (if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
[x0 y0 x1 y1] [x0 y0 x1 y1]

9
frontend/src/arthur/domain/node.cljs
View file

@ -107,10 +107,13 @@
(defn toggle-key (defn toggle-key
"Key channel `path` on the node's own frame `f` with the value it has there, or "Key channel `path` on the node's own frame `f` with the value it has there, or
take the key there off. The first key starts the channel animating and taking take the key there off. The first key starts the channel animating and taking
the last one off leaves it that one value. A boolean holds; anything else tweens." the last one off leaves it that one value. A boolean holds; anything else tweens.
[n path f]
`store` because the value it keys is read out of the channel, and a measured
channel's values live in tier 2."
[n path f store]
(let [c (get (channels n) path) (let [c (get (channels n) path)
v (ch/value-at c f) v (ch/value-at c f store)
ks (dissoc (:keys c) f)] ks (dissoc (:keys c) f)]
(assoc-in n [:channels path] (assoc-in n [:channels path]
(cond (cond

6
frontend/src/arthur/domain/paint.cljs
View file

@ -25,7 +25,7 @@
{:id id :name (str "shape " (inc (count (shapes clip sid)))) {:id id :name (str "shape " (inc (count (shapes clip sid))))
:kind :poly :paint? true :parent nil :z z :kind :poly :paint? true :parent nil :z z
:span [frame end] :span [frame end]
:channels {geometry (channel/keyed {frame points}) :channels {geometry (channel/keyed {frame points} :hold)
[:style :color] (channel/framed color) [:style :color] (channel/framed color)
;; Turned and scaled about its middle, as a placed ;; Turned and scaled about its middle, as a placed
;; symbol is: set once here and never followed. ;; symbol is: set once here and never followed.
@ -41,7 +41,9 @@
[start end] (:span node)] [start end] (:span node)]
(if (and (:paint? node) (<= start frame) (< frame end) ch) (if (and (:paint? node) (<= start frame) (< frame end) ch)
(assoc-in clip (into path [:channels geometry :keys frame]) (assoc-in clip (into path [:channels geometry :keys frame])
(vec (channel/value-at ch frame))) ;; A drawing is authored and keyed, never dense, so there is
;; no tier-2 store to read it out of.
(vec (channel/value-at ch frame nil)))
clip))) clip)))
(defn set-vertex [clip sid id key-frame vertex [x y]] (defn set-vertex [clip sid id key-frame vertex [x y]]

8
frontend/src/arthur/domain/pick.cljs
View file

@ -101,7 +101,7 @@
(let [sid (:of n) (let [sid (:of n)
frames (clip/frames document sid) frames (clip/frames document sid)
loop? (get-in n [:time :loop?]) loop? (get-in n [:time :loop?])
resolve (clip/resolver document store pal/index-of sid)] resolve (clip/resolver document store pal/index-of sid nil)]
(fn [f] (fn [f]
(let [f (if loop? (mod f frames) f)] (let [f (if loop? (mod f frames) f)]
(when (< -1 f frames) (when (< -1 f frames)
@ -128,12 +128,6 @@
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h])))) (when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h]))))
(constantly nil)))) (constantly nil))))
(defn local-bounds
"`[x0 y0 x1 y1]` around what node `n` draws on its own frame `f`, in its own
coordinates, or nil when it draws nothing there."
[document store n f]
((bounds-of document store n) f))
(defn pivot (defn pivot
"The middle of everything node `n` draws over its own frames `fs`, in its own "The middle of everything node `n` draws over its own frames `fs`, in its own
coordinates — where it should turn and scale about. Nil for a node that draws coordinates — where it should turn and scale about. Nil for a node that draws

15
frontend/src/arthur/domain/symbol.cljs
View file

@ -422,10 +422,7 @@
the only place the space changes. the only place the space changes.
This is the definition of what a frame means. `resolver` is what plays it." This is the definition of what a frame means. `resolver` is what plays it."
([sym f] (eval-frame sym f nil pal/index-of)) [sym f store palette pose-tracks opts]
([sym f store] (eval-frame sym f store pal/index-of))
([sym f store palette] (eval-frame sym f store palette nil nil))
([sym f store palette pose-tracks opts]
(let [nodes (nodes-of sym) (let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks) choices (pose/prepare pose-tracks)
traces (prepared-traces nodes) traces (prepared-traces nodes)
@ -440,7 +437,7 @@
:pinv-for (fn [id] (node/pinv (get nodes id))) :pinv-for (fn [id] (node/pinv (get nodes id)))
:buf-for (fn [_id n] (js/Float64Array. (* 2 n))) :buf-for (fn [_id n] (js/Float64Array. (* 2 n)))
:scratch (node/mat)} :scratch (node/mat)}
nodes ord (draw-rank nodes ord) f)))) nodes ord (draw-rank nodes ord) f)))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the playback path ;; the playback path
@ -485,11 +482,7 @@
The op maps themselves are allocated fresh, and deliberately: there are a dozen The op maps themselves are allocated fresh, and deliberately: there are a dozen
of them per frame against hundreds of points, so pooling them would buy of them per frame against hundreds of points, so pooling them would buy
nothing and cost the ability to hand an op list around as plain data." nothing and cost the ability to hand an op list around as plain data."
([sym] (resolver sym nil pal/index-of nil nil)) [sym store palette pose-tracks {:keys [source-fps picture-fps]}]
([sym store] (resolver sym store pal/index-of nil nil))
([sym store palette] (resolver sym store palette nil nil))
([sym store palette pose-tracks] (resolver sym store palette pose-tracks nil))
([sym store palette pose-tracks {:keys [source-fps picture-fps]}]
(let [nodes (nodes-of sym) (let [nodes (nodes-of sym)
choices (pose/prepare pose-tracks) choices (pose/prepare pose-tracks)
traces (prepared-traces nodes) traces (prepared-traces nodes)
@ -532,7 +525,7 @@
(-invoke [_ f] (step f)) (-invoke [_ f] (step f))
IResolver IResolver
(world-of [_ id] (:m (get @placed id))) (world-of [_ id] (:m (get @placed id)))
(frame-of [_ id] (:f (get @placed id))))))) (frame-of [_ id] (:f (get @placed id))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------

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

@ -622,7 +622,8 @@
(rf/reg-event-db (rf/reg-event-db
::toggle-key ::toggle-key
(fn [db [_ sid id path frame]] (fn [db [_ sid id path frame]]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame)))) (let [st (:store (store/entry (:clip/current db)))]
(edit/edit db #(update-in % [:symbols sid :nodes id] node/toggle-key path frame st)))))
;; A face's trace frames and origin, on its symbol — see `domain/trace`. ;; A face's trace frames and origin, on its symbol — see `domain/trace`.
(rf/reg-event-db (rf/reg-event-db

4
frontend/src/arthur/flow/freeze.cljs
View file

@ -312,7 +312,7 @@
(when (or (zero? f) (when (or (zero? f)
(not= (nth shown f) (nth shown (dec f)))) (not= (nth shown f) (nth shown (dec f))))
[f (nth shown f)]))) [f (nth shown f)])))
(range (count shown)))) (range (count shown))) :hold)
:generated generated))) :generated generated)))
(defn- keyed-visibility [values generated] (defn- keyed-visibility [values generated]
@ -320,7 +320,7 @@
(when (or (zero? f) (when (or (zero? f)
(not= (nth values f) (nth values (dec f)))) (not= (nth values f) (nth values (dec f))))
[f (nth values f)]))) [f (nth values f)])))
(range (count values)))) (range (count values))) :hold)
:generated generated)) :generated generated))
(def ^:private pose-groups (def ^:private pose-groups

5
frontend/src/arthur/footage/store.cljs
View file

@ -18,14 +18,13 @@
with nothing to evict it, and the timeline that would want several is out of with nothing to evict it, and the timeline that would want several is out of
scope. `kind` only names the id — `:footage/3`, `:project/4` — so that a clip's scope. `kind` only names the id — `:footage/3`, `:project/4` — so that a clip's
origin is legible in the db without a lookup." origin is legible in the db without a lookup."
([entry] (install! entry "footage")) [entry kind]
([entry kind]
(let [id (keyword kind (str (swap! serial inc)))] (let [id (keyword kind (str (swap! serial inc)))]
(when-let [old (:audio @loaded)] (when-let [old (:audio @loaded)]
(when (and (not= old (:audio entry)) (.startsWith old "blob:")) (when (and (not= old (:audio entry)) (.startsWith old "blob:"))
(js/URL.revokeObjectURL old))) (js/URL.revokeObjectURL old)))
(reset! loaded (assoc entry :id id)) (reset! loaded (assoc entry :id id))
id))) id))
(defn entry [id] (defn entry [id]
(if (= id (:id @loaded)) (if (= id (:id @loaded))

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

@ -66,7 +66,7 @@
(when n (when n
(let [st (:store (store/entry clip-id))] (let [st (:store (store/entry clip-id))]
(when-let [pl (nest/placement clip st open (or path [id]) f)] (when-let [pl (nest/placement clip st open (or path [id]) f)]
(assoc pl :node n :bounds (pick/local-bounds clip st n (:frame pl)))))))) (assoc pl :node n :bounds ((pick/bounds-of clip st n) (:frame pl))))))))
(rf/reg-sub (rf/reg-sub
::project-footage ::project-footage

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

@ -29,7 +29,7 @@
:disc (select-keys op [:kind :cx :cy :r]) :disc (select-keys op [:kind :cx :cy :r])
:rect (select-keys op [:kind :cx :cy :size]) :rect (select-keys op [:kind :cx :cy :size])
nil)) nil))
((clip/resolver document st pal/index-of sid) 0)))) ((clip/resolver document st pal/index-of sid nil) 0))))
(defn symbol! (defn symbol!
"Start carrying symbol `sid` of the loaded document into the open symbol." "Start carrying symbol `sid` of the loaded document into the open symbol."

4
frontend/src/arthur/ui/params.cljs
View file

@ -180,7 +180,9 @@
(defn- channel-control [sid id path ch frame] (defn- channel-control [sid id path ch frame]
(let [keyed? (some? (:keys ch)) (let [keyed? (some? (:keys ch))
v (channel/value-at ch (or frame 0)) ;; No store: the call site below hands this only channels that are not
;; `:dense`, which are the only ones with anything in tier 2 to read.
v (channel/value-at ch (or frame 0) nil)
off? (and keyed? (nil? frame)) off? (and keyed? (nil? frame))
deg? (= path [:xform :rot]) deg? (= path [:xform :rot])
;; A boolean has nothing between true and false to tween through. ;; A boolean has nothing between true and false to tween through.

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

@ -231,7 +231,8 @@
:w w :h h} :w w :h h}
points? @(rf/subscribe [::sub/points]) points? @(rf/subscribe [::sub/points])
[sid id geom active editable? frame matrix] (when points? (editing)) [sid id geom active editable? frame matrix] (when points? (editing))
pts (when geom (through matrix (channel/value-at geom frame)))] pts (when geom (through matrix (channel/value-at geom frame
(:store (store/entry clip-id)))))]
[:svg {:class (str "paint-overlay" (when drawing? " drawing")) [:svg {:class (str "paint-overlay" (when drawing? " drawing"))
:width (* zoom w) :height (* zoom h) :width (* zoom w) :height (* zoom h)
:view-box (str "0 0 " w " " h) :view-box (str "0 0 " w " " h)

2
frontend/test/arthur/bench_test.cljs
View file

@ -24,7 +24,7 @@
(/ dt n)))) (/ dt n))))
(deftest bench (deftest bench
(let [res (symbol/resolver (clip/symbol @swarm/clip :main) @swarm/store pal/index-of) (let [res (symbol/resolver (clip/symbol @swarm/clip :main) @swarm/store pal/index-of nil nil)
ras (raster/make 320 200) ras (raster/make 320 200)
dest (js/Uint8ClampedArray. (* 320 200 4)) dest (js/Uint8ClampedArray. (* 320 200 4))
n 120] n 120]

68
frontend/test/arthur/domain/channel_test.cljs
View file

@ -11,55 +11,55 @@
(deftest framed-is-the-same-value-at-every-frame (deftest framed-is-the-same-value-at-every-frame
(let [c (ch/framed :skin-dark)] (let [c (ch/framed :skin-dark)]
(is (= :framed (ch/describe c))) (is (= :framed (ch/describe c)))
(is (every? #(= :skin-dark (ch/value-at c %)) (range -5 20))))) (is (every? #(= :skin-dark (ch/value-at c % nil)) (range -5 20)))))
(deftest keyed-holds-until-the-next-key (deftest keyed-holds-until-the-next-key
;; Hold is the DEFAULT, not a special case: docs/design.md requires it of every ;; Hold is the DEFAULT, not a special case: docs/design.md requires it of every
;; cut part, and a tweened mouth reads as puppet software. ;; cut part, and a tweened mouth reads as puppet software.
(let [c (ch/keyed {0 :a, 4 :b, 12 :c})] (let [c (ch/keyed {0 :a, 4 :b, 12 :c} :hold)]
(is (= :keyed (ch/describe c))) (is (= :keyed (ch/describe c)))
(is (= [:a :a :a :a :b :b :b :b :b :b :b :b :c :c] (is (= [:a :a :a :a :b :b :b :b :b :b :b :b :c :c]
(mapv #(ch/value-at c %) (range 0 14)))))) (mapv #(ch/value-at c % nil) (range 0 14))))))
(deftest linear-vector-keys-interpolate-each-component (deftest linear-vector-keys-interpolate-each-component
(let [c (ch/keyed {0 [0.4 0.6], 10 [0.6 0.4]} :linear) (let [c (ch/keyed {0 [0.4 0.6], 10 [0.6 0.4]} :linear)
frames [0 5 10 5 2] frames [0 5 10 5 2]
cursor (ch/cursor c)] cursor (ch/cursor c nil)]
(is (empty? (ch/problems c))) (is (empty? (ch/problems c)))
(is (= [0.5 0.5] (ch/value-at c 5))) (is (= [0.5 0.5] (ch/value-at c 5 nil)))
(is (= (mapv #(ch/value-at c %) frames) (is (= (mapv #(ch/value-at c % nil) frames)
(mapv #(ch/sample! cursor %) frames))))) (mapv #(ch/sample! cursor %) frames)))))
(deftest one-channel-can-cut-then-tween (deftest one-channel-can-cut-then-tween
(let [c (assoc (ch/keyed {0 [0 0], 4 [4 0], 8 [8 0]}) (let [c (assoc (ch/keyed {0 [0 0], 4 [4 0], 8 [8 0]} :hold)
:segments {4 :linear}) :segments {4 :linear})
cursor (ch/cursor c)] cursor (ch/cursor c nil)]
(is (= [0 0] (ch/value-at c 2))) (is (= [0 0] (ch/value-at c 2 nil)))
(is (= [4 0] (ch/value-at c 4))) (is (= [4 0] (ch/value-at c 4 nil)))
(is (= [6 0] (ch/value-at c 6))) (is (= [6 0] (ch/value-at c 6 nil)))
(is (= (mapv #(ch/value-at c %) [0 2 4 6 8 3 7]) (is (= (mapv #(ch/value-at c % nil) [0 2 4 6 8 3 7])
(mapv #(ch/sample! cursor %) [0 2 4 6 8 3 7]))))) (mapv #(ch/sample! cursor %) [0 2 4 6 8 3 7])))))
(deftest a-frame-before-the-first-key-reads-the-first-key (deftest a-frame-before-the-first-key-reads-the-first-key
;; The JS activeKey clamps low, and that is kept: a channel's first key is the ;; The JS activeKey clamps low, and that is kept: a channel's first key is the
;; pose the part starts in. Having NO value is a different question — it is a ;; pose the part starts in. Having NO value is a different question — it is a
;; state bit, not an empty region of the key map. ;; state bit, not an empty region of the key map.
(let [c (ch/keyed {10 :a, 20 :b})] (let [c (ch/keyed {10 :a, 20 :b} :hold)]
(is (= :a (ch/value-at c 0))) (is (= :a (ch/value-at c 0 nil)))
(is (= :a (ch/value-at c 9))) (is (= :a (ch/value-at c 9 nil)))
(is (= :b (ch/value-at c 999)) "and clamps high by holding the last key"))) (is (= :b (ch/value-at c 999 nil)) "and clamps high by holding the last key")))
(deftest keys-are-a-map-so-frame-order-in-the-literal-cannot-matter (deftest keys-are-a-map-so-frame-order-in-the-literal-cannot-matter
;; Transit and JSON both lose sortedness, so the sorted index is built at read ;; Transit and JSON both lose sortedness, so the sorted index is built at read
;; time. A resolver that trusted insertion order would work in the REPL and ;; time. A resolver that trusted insertion order would work in the REPL and
;; fail after a round trip through the server, which is the worst possible way ;; fail after a round trip through the server, which is the worst possible way
;; to find out. ;; to find out.
(let [forward (ch/keyed (array-map 0 :a, 4 :b, 12 :c)) (let [forward (ch/keyed (array-map 0 :a, 4 :b, 12 :c) :hold)
backward (ch/keyed (array-map 12 :c, 4 :b, 0 :a)) backward (ch/keyed (array-map 12 :c, 4 :b, 0 :a) :hold)
shuffled (ch/keyed (array-map 4 :b, 12 :c, 0 :a))] shuffled (ch/keyed (array-map 4 :b, 12 :c, 0 :a) :hold)]
(doseq [c [backward shuffled]] (doseq [c [backward shuffled]]
(is (= (mapv #(ch/value-at forward %) (range 0 16)) (is (= (mapv #(ch/value-at forward % nil) (range 0 16))
(mapv #(ch/value-at c %) (range 0 16))))))) (mapv #(ch/value-at c % nil) (range 0 16)))))))
(deftest dense-reads-one-value-per-frame-out-of-a-typed-array (deftest dense-reads-one-value-per-frame-out-of-a-typed-array
(let [store {"blk" {:data (js/Int16Array. #js [0 0, 10 20, 30 40, 50 60]) :state nil}} (let [store {"blk" {:data (js/Int16Array. #js [0 0, 10 20, 30 40, 50 60]) :state nil}}
@ -148,7 +148,7 @@
"Sample one cursor at each of `fs` in the order given, which is the point: a "Sample one cursor at each of `fs` in the order given, which is the point: a
cursor carries state between calls." cursor carries state between calls."
[c fs] [c fs]
(let [cur (ch/cursor c)] (let [cur (ch/cursor c nil)]
(mapv #(ch/sample! cur %) fs))) (mapv #(ch/sample! cur %) fs)))
(deftest the-cursor-agrees-with-the-specification-in-any-frame-order (deftest the-cursor-agrees-with-the-specification-in-any-frame-order
@ -156,11 +156,11 @@
;; the WRONG POSE rather than an error, so nothing would report it: the mouth ;; the WRONG POSE rather than an error, so nothing would report it: the mouth
;; would simply be a beat behind on some frames and not others, which reads as ;; would simply be a beat behind on some frames and not others, which reads as
;; a bad take. ;; a bad take.
(doseq [[label c] [["sparse" (ch/keyed {0 :a, 4 :b, 12 :c, 13 :d, 40 :e})] (doseq [[label c] [["sparse" (ch/keyed {0 :a, 4 :b, 12 :c, 13 :d, 40 :e} :hold)]
["one key" (ch/keyed {7 :only})] ["one key" (ch/keyed {7 :only} :hold)]
["dense-ish" (ch/keyed (into {} (map (juxt identity #(* 10 %))) (range 40)))] ["dense-ish" (ch/keyed (into {} (map (juxt identity #(* 10 %))) (range 40)) :hold)]
["framed" (ch/framed :static)]]] ["framed" (ch/framed :static)]]]
(let [spec #(ch/value-at c %) (let [spec #(ch/value-at c % nil)
forward (range 0 45) forward (range 0 45)
back (reverse forward) back (reverse forward)
jumpy [0 44 1 43 12 12 13 3 40 7 0 22 22 21 44]] jumpy [0 44 1 43 12 12 13 3 40 7 0 22 22 21 44]]
@ -220,20 +220,20 @@
;; step. Dropping one silently would present as a hand correction that did not ;; step. Dropping one silently would present as a hand correction that did not
;; take — a correction the user made once, watched fail, and has no reason to ;; take — a correction the user made once, watched fail, and has no reason to
;; trust again. ;; trust again.
(let [c (assoc (ch/keyed {0 [0 0]}) :over [{:blend :offset :keys {0 [2 0]}}])] (let [c (assoc (ch/keyed {0 [0 0]} :hold) :over [{:blend :offset :keys {0 [2 0]}}])]
(is (thrown-with-msg? ExceptionInfo #":over" (ch/value-at c 0))) (is (thrown-with-msg? ExceptionInfo #":over" (ch/value-at c 0 nil)))
(is (thrown-with-msg? ExceptionInfo #":over" (ch/cursor c))) (is (thrown-with-msg? ExceptionInfo #":over" (ch/cursor c nil)))
(is (seq (ch/problems c))))) (is (seq (ch/problems c)))))
(deftest an-empty-over-is-fine-and-is-what-scenes-carry (deftest an-empty-over-is-fine-and-is-what-scenes-carry
(is (empty? (ch/problems (ch/keyed {0 1})))) (is (empty? (ch/problems (ch/keyed {0 1} :hold))))
(is (= 1 (ch/value-at (ch/keyed {0 1}) 0)))) (is (= 1 (ch/value-at (ch/keyed {0 1} :hold) 0 nil))))
;; ---- shape validation ---- ;; ---- shape validation ----
(deftest problems-names-the-ways-a-channel-is-malformed (deftest problems-names-the-ways-a-channel-is-malformed
(is (empty? (ch/problems (ch/framed 1)))) (is (empty? (ch/problems (ch/framed 1))))
(is (empty? (ch/problems (ch/keyed {0 1})))) (is (empty? (ch/problems (ch/keyed {0 1} :hold))))
(testing "keys as a vector is the mistake most worth catching" (testing "keys as a vector is the mistake most worth catching"
(is (seq (ch/problems {:animated? true :keys [[0 1]]})))) (is (seq (ch/problems {:animated? true :keys [[0 1]]}))))
(is (seq (ch/problems {:value 1})) "no :animated?") (is (seq (ch/problems {:value 1})) "no :animated?")
@ -248,9 +248,9 @@
(deftest numeric-channels-can-ramp-between-keys (deftest numeric-channels-can-ramp-between-keys
(let [c (ch/keyed {0 0.0, 10 1.0} :linear) (let [c (ch/keyed {0 0.0, 10 1.0} :linear)
cursor (ch/cursor c)] cursor (ch/cursor c nil)]
(is (= [0.0 0.5 1.0 1.0] (is (= [0.0 0.5 1.0 1.0]
(mapv #(ch/value-at c %) [0 5 10 15]))) (mapv #(ch/value-at c % nil) [0 5 10 15])))
(is (= [0.0 0.5 1.0 0.2] (is (= [0.0 0.5 1.0 0.2]
(mapv #(ch/sample! cursor %) [0 5 10 2]))))) (mapv #(ch/sample! cursor %) [0 5 10 2])))))

10
frontend/test/arthur/domain/gesture_test.cljs
View file

@ -34,7 +34,7 @@
(defn- drawn [c path] (defn- drawn [c path]
(partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %)) (partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %))
((clip/resolver c nil pal/index-of :main) 16)))))))) ((clip/resolver c nil pal/index-of :main nil) 16))))))))
(defn- near? [a b] (every? #(< (js/Math.abs %) 1e-9) (map - (flatten a) (flatten b)))) (defn- near? [a b] (every? #(< (js/Math.abs %) 1e-9) (map - (flatten a) (flatten b))))
@ -98,7 +98,7 @@
[c st open path f] [c st open path f]
(let [{:keys [sid id world frame]} (nest/placement c st open path f) (let [{:keys [sid id world frame]} (nest/placement c st open path f)
n (get-in c [:symbols sid :nodes id]) n (get-in c [:symbols sid :nodes id])
[x0 y0 x1 y1] (pick/local-bounds c st n frame)] [x0 y0 x1 y1] ((pick/bounds-of c st n) frame)]
{:corners (mapv #(at world %) [[x0 y0] [x1 y0] [x1 y1] [x0 y1]]) {:corners (mapv #(at world %) [[x0 y0] [x1 y0] [x1 y1] [x0 y1]])
:pivot (at world (:anchor (gesture/values n frame st)))})) :pivot (at world (:anchor (gesture/values n frame st)))}))
@ -259,7 +259,7 @@
(deftest a-measured-transform-is-not-set-by-hand (deftest a-measured-transform-is-not-set-by-hand
(is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}}))) (is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}})))
(is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]})}})))) (is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]} :hold)}}))))
(deftest a-click-selects-the-level-figma-would (deftest a-click-selects-the-level-figma-would
(let [hit [:a :b :c :shape]] (let [hit [:a :b :c :shape]]
@ -287,5 +287,5 @@
(deftest an-instances-box-is-what-its-symbol-draws (deftest an-instances-box-is-what-its-symbol-draws
(let [c (two-down) (let [c (two-down)
{:keys [frame]} (nest/placement c nil :main [u v] 16)] {:keys [frame]} (nest/placement c nil :main [u v] 16)]
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :mid :nodes v]) frame))) (is (= [0 0 10 10] ((pick/bounds-of c nil (get-in c [:symbols :mid :nodes v])) frame)))
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :box :nodes :shape]) 4))))) (is (= [0 0 10 10] ((pick/bounds-of c nil (get-in c [:symbols :box :nodes :shape])) 4)))))

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

@ -17,7 +17,7 @@
:nodes {:root {:id :root :kind :group :z "a1"} :nodes {:root {:id :root :kind :group :z "a1"}
:mark {:id :mark :kind :rect :parent :root :z "a1" :mark {:id :mark :kind :rect :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0] :channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0]
2 [20 0] 3 [30 0]}) 2 [20 0] 3 [30 0]} :hold)
[:geom :size] (ch/framed 4) [:geom :size] (ch/framed 4)
[:style :color] (ch/framed :brow)}}}}}}) [:style :color] (ch/framed :brow)}}}}}})
@ -36,7 +36,7 @@
:channels {[:xform :pos] (ch/framed [120 50])}}}}) :channels {[:xform :pos] (ch/framed [120 50])}}}})
(assoc-in [:symbols :sym/test] (assoc-in [:symbols :sym/test]
(assoc (get-in source [:symbols :main]) :id :sym/test))) (assoc (get-in source [:symbols :main]) :id :sym/test)))
resolve (clip/resolver document nil pal/index-of :main) resolve (clip/resolver document nil pal/index-of :main nil)
at (fn [f] (mapv (juxt :node :cx) (resolve f)))] at (fn [f] (mapv (juxt :node :cx) (resolve f)))]
(is (empty? (clip/problems document))) (is (empty? (clip/problems document)))
(is (= [[[:left :mark] 110]] (at 1))) (is (= [[[:left :mark] 110]] (at 1)))
@ -46,13 +46,13 @@
(deftest a-placement-holds-and-cuts-each-generated-shape-independently (deftest a-placement-holds-and-cuts-each-generated-shape-independently
(let [values (js/Int16Array. (clj->js (range 2 32))) (let [values (js/Int16Array. (clj->js (range 2 32)))
visible (ch/keyed {0 true 20 true 21 false}) visible (ch/keyed {0 true 20 true 21 false} :hold)
dense {:animated? true :interp :hold dense {:animated? true :interp :hold
:dense {:store "sizes" :offset 0 :stride 1 :frames 30} :dense {:store "sizes" :offset 0 :stride 1 :frames 30}
:pose-sampled? true} :pose-sampled? true}
shape (fn [id z group] shape (fn [id z group]
{:id id :kind :rect :parent :root :z z :pose-group group {:id id :kind :rect :parent :root :z z :pose-group group
:channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]}) :channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]} :hold)
[:geom :size] dense [:geom :size] dense
[:vis] (assoc visible :pose-sampled? true) [:vis] (assoc visible :pose-sampled? true)
[:style :color] (ch/framed :brow)}}) [:style :color] (ch/framed :brow)}})
@ -75,7 +75,7 @@
:parent :root :z "a2" :parent :root :z "a2"
:playback {:tracks {:mouth {0 0, 8 8}}}}}} :playback {:tracks {:mouth {0 0, 8 8}}}}}}
:sym/poses symbol}} :sym/poses symbol}}
resolve (clip/resolver document {"sizes" {:data values}} pal/index-of :main) resolve (clip/resolver document {"sizes" {:data values}} pal/index-of :main nil)
low-resolve (clip/resolver document {"sizes" {:data values}} low-resolve (clip/resolver document {"sizes" {:data values}}
pal/index-of :main {:picture-fps 8}) pal/index-of :main {:picture-fps 8})
at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f))) at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f)))
@ -178,15 +178,15 @@
scale (get-in left [:channels [:xform :scale]]) scale (get-in left [:channels [:xform :scale]])
anchor (get-in left [:channels [:xform :anchor] :value]) anchor (get-in left [:channels [:xform :anchor] :value])
pos (get-in left [:channels [:xform :pos]]) pos (get-in left [:channels [:xform :pos]])
start-pos (ch/value-at pos 0)] start-pos (ch/value-at pos 0 nil)]
(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))
(is (not= start-pos (ch/value-at pos 40)) "the face drifts during playback") (is (not= start-pos (ch/value-at pos 40 nil)) "the face drifts during playback")
(is (= [0.4 0.4] (ch/value-at scale 0))) (is (= [0.4 0.4] (ch/value-at scale 0 nil)))
(is (= [0.56 0.56] (ch/value-at scale 12))) (is (= [0.56 0.56] (ch/value-at scale 12 nil)))
(is (= [0.52 0.52] (ch/value-at scale 48))) (is (= [0.52 0.52] (ch/value-at scale 48 nil)))
(doseq [f [0 12 48]] (doseq [f [0 12 48]]
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f) [0 0] anchor) (let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f nil) [0 0] anchor)
out (js/Float64Array. 2)] out (js/Float64Array. 2)]
(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)])
@ -200,10 +200,10 @@
(is (= [48 260] (node/placed-span (placement document :voice-right)))) (is (= [48 260] (node/placed-span (placement document :voice-right))))
(is (= 0.5 (ch/value-at (is (= 0.5 (ch/value-at
(get-in (placement document :voice-right) (get-in (placement document :voice-right)
[:channels [:audio :gain]]) 54))) [:channels [:audio :gain]]) 54 nil)))
(is (< -0.8 (ch/value-at (is (< -0.8 (ch/value-at
(get-in (placement document :voice-right) (get-in (placement document :voice-right)
[:channels [:audio :pan]]) 110) 0.7)) [:channels [:audio :pan]]) 110 nil) 0.7))
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document)))))) (is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
(defn- nested (defn- nested

14
frontend/test/arthur/domain/nest_test.cljs
View file

@ -40,7 +40,7 @@
{:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn) {:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn)
c (paint/new-shape c sid :shape frame pts :brow) c (paint/new-shape c sid :shape frame pts :brow)
[op] (filter #(= [u :shape] (:node %)) [op] (filter #(= [u :shape] (:node %))
((clip/resolver c nil pal/index-of :main) 16))] ((clip/resolver c nil pal/index-of :main nil) 16))]
(is (= :box sid)) (is (= :box sid))
(is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10") (is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10")
(is (every? #(< (js/Math.abs %) 1e-9) (is (every? #(< (js/Math.abs %) 1e-9)
@ -64,7 +64,7 @@
(turn :mid v [5 -3] 0.3 1.5) (turn :mid v [5 -3] 0.3 1.5)
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow)) (paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow))
draw #(take 6 (array-seq (:pts (first (filter (fn [op] (= [u v :shape] (:node op))) draw #(take 6 (array-seq (:pts (first (filter (fn [op] (= [u v :shape] (:node op)))
((clip/resolver % nil pal/index-of :main) 16)))))) ((clip/resolver % nil pal/index-of :main nil) 16))))))
{:keys [frame matrix time]} (nest/inside c nil :main [u v :shape] 16) {:keys [frame matrix time]} (nest/inside c nil :main [u v :shape] 16)
out (js/Float64Array. 2) out (js/Float64Array. 2)
seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y)))) seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y))))
@ -86,7 +86,7 @@
(deftest a-placed-symbols-sound-is-heard-where-it-is-placed (deftest a-placed-symbols-sound-is-heard-where-it-is-placed
(let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1" (let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1"
:span [10 40] :time {:mode :map :at -10 :rate 1} :span [10 40] :time {:mode :map :at -10 :rate 1}
:channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}} :channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0} :hold)}}
c (-> (clip/blank) c (-> (clip/blank)
(assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}}) (assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}})
(clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil)) (clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil))
@ -105,7 +105,7 @@
"What `sid` draws at each of `fs`, without the node paths a move changes: "What `sid` draws at each of `fs`, without the node paths a move changes:
per frame, the sorted marks with their points rounded to a thousandth." per frame, the sorted marks with their points rounded to a thousandth."
[c sid fs] [c sid fs]
(let [resolve (clip/resolver c nil pal/index-of sid) (let [resolve (clip/resolver c nil pal/index-of sid nil)
round #(/ (js/Math.round (* 1000 %)) 1000)] round #(/ (js/Math.round (* 1000 %)) 1000)]
(mapv (fn [f] (mapv (fn [f]
(sort-by str (map (fn [op] (sort-by str (map (fn [op]
@ -122,7 +122,7 @@
[] []
(let [tri (fn [id x keyed] (let [tri (fn [id x keyed]
{:id id :kind :poly :z "a1" :paint? true :span [4 60] {:id id :kind :poly :z "a1" :paint? true :span [4 60]
:channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed)) :channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed) :hold)
[:style :color] (ch/framed :brow)}})] [:style :color] (ch/framed :brow)}})]
(-> (clip/blank) (-> (clip/blank)
(assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40})) (assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40}))
@ -199,7 +199,7 @@
(update-in [:symbols :main :nodes] dissoc :tri) (update-in [:symbols :main :nodes] dissoc :tri)
(assoc-in [:symbols :main :nodes a-uuid :time :rate] 2) (assoc-in [:symbols :main :nodes a-uuid :time :rate] 2)
(assoc-in [:symbols :box :nodes :inner :channels [:geom :pts]] (assoc-in [:symbols :box :nodes :inner :channels [:geom :pts]]
(ch/keyed {4 [5 10 15 10 5 40] 20 [5 10 45 10 5 40]}))) (ch/keyed {4 [5 10 15 10 5 40] 20 [5 10 45 10 5 40]} :hold)))
{slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6) {slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6)
fs [13 15 18 20]] fs [13 15 18 20]]
(is (nil? (:refused r)) (:refused r)) (is (nil? (:refused r)) (:refused r))
@ -251,7 +251,7 @@
(is (= [0 8] (:span heard)) (is (= [0 8] (:span heard))
"own frames 0-8: it starts on inner's 2 and inner ends on 10") "own frames 0-8: it starts on inner's 2 and inner ends on 10")
(is (= [7 15] (node/placed-span heard)) "inner starts on 5 of outer") (is (= [7 15] (node/placed-span heard)) "inner starts on 5 of outer")
(is (empty? ((clip/resolver c nil pal/index-of :inner) 3)) (is (empty? ((clip/resolver c nil pal/index-of :inner nil) 3))
"and it draws nothing") "and it draws nothing")
(is (= c (clip/place-sound c :inner {:sound "tone"} "tone.mp3" 40 1 10 (random-uuid))) (is (= c (clip/place-sound c :inner {:sound "tone"} "tone.mp3" 40 1 10 (random-uuid)))
"nor lands past the end of its symbol") "nor lands past the end of its symbol")

24
frontend/test/arthur/domain/node_test.cljs
View file

@ -145,14 +145,14 @@
(deftest transform-channels-default-to-the-identity (deftest transform-channels-default-to-the-identity
(let [chs (node/channels {:id :x :kind :group})] (let [chs (node/channels {:id :x :kind :group})]
(is (= [0.0 0.0] (ch/value-at (get chs [:xform :pos]) 0))) (is (= [0.0 0.0] (ch/value-at (get chs [:xform :pos]) 0 nil)))
(is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0))) (is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0 nil)))
(is (= true (ch/value-at (get chs [:vis]) 0)))) (is (= true (ch/value-at (get chs [:vis]) 0 nil))))
(testing "and a node's own channels win" (testing "and a node's own channels win"
(let [chs (node/channels {:id :x :kind :group (let [chs (node/channels {:id :x :kind :group
:channels {[:xform :pos] (ch/framed [5 5])}})] :channels {[:xform :pos] (ch/framed [5 5])}})]
(is (= [5 5] (ch/value-at (get chs [:xform :pos]) 0))) (is (= [5 5] (ch/value-at (get chs [:xform :pos]) 0 nil)))
(is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0)))))) (is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0 nil))))))
(deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them (deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them
;; A decomposition is not extensible after the fact: adding a component later ;; A decomposition is not extensible after the fact: adding a component later
@ -193,26 +193,26 @@
(deftest keying-a-channel-from-the-inspector (deftest keying-a-channel-from-the-inspector
(let [n {:id :x :kind :group} (let [n {:id :x :kind :group}
a (node/set-channel n [:xform :rot] 3 1.0) a (node/set-channel n [:xform :rot] 3 1.0)
b (node/toggle-key a [:xform :rot] 3) b (node/toggle-key a [:xform :rot] 3 nil)
c (-> b (node/set-channel [:xform :pos] 9 [5 5]) c (-> b (node/set-channel [:xform :pos] 9 [5 5])
(node/toggle-key [:xform :pos] 0) (node/toggle-key [:xform :pos] 0 nil)
(node/set-channel [:xform :pos] 10 [10 0])) (node/set-channel [:xform :pos] 10 [10 0]))
rot #(ch/value-at (get (node/channels %1) [:xform :rot]) %2) rot #(ch/value-at (get (node/channels %1) [:xform :rot]) %2 nil)
pos #(ch/value-at (get (node/channels %1) [:xform :pos]) %2)] pos #(ch/value-at (get (node/channels %1) [:xform :pos]) %2 nil)]
(is (= 1.0 (rot a 50)) "an unkeyed channel is its one value") (is (= 1.0 (rot a 50)) "an unkeyed channel is its one value")
(is (= {3 1.0} (get-in b [:channels [:xform :rot] :keys])) "the first key is its value here") (is (= {3 1.0} (get-in b [:channels [:xform :rot] :keys])) "the first key is its value here")
(is (= [7.5 2.5] (pos c 5)) "an edit on a keyed channel keys it, and keys tween") (is (= [7.5 2.5] (pos c 5)) "an edit on a keyed channel keys it, and keys tween")
(is (= 1.0 (rot (node/set-channel b [:xform :rot] 8 2.0) 3)) "without moving the key before it") (is (= 1.0 (rot (node/set-channel b [:xform :rot] 8 2.0) 3)) "without moving the key before it")
(let [d (node/toggle-key b [:xform :rot] 3)] (let [d (node/toggle-key b [:xform :rot] 3 nil)]
(is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again") (is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again")
(is (= 1.0 (rot d 0)))) (is (= 1.0 (rot d 0))))
(is (= :hold (get-in (node/toggle-key n [:vis] 0) [:channels [:vis] :interp])) "a boolean holds") (is (= :hold (get-in (node/toggle-key n [:vis] 0 nil) [:channels [:vis] :interp])) "a boolean holds")
(let [h (node/set-segment-interp c [:xform :pos] 0 :hold)] (let [h (node/set-segment-interp c [:xform :pos] 0 :hold)]
(is (= [5 5] (pos h 5)) "a gap set to hold cuts at the next key") (is (= [5 5] (pos h 5)) "a gap set to hold cuts at the next key")
(is (= [10 0] (pos h 10))) (is (= [10 0] (pos h 10)))
(is (= [7.5 2.5] (pos (node/set-segment-interp h [:xform :pos] 0 :linear) 5)) "and back to a tween") (is (= [7.5 2.5] (pos (node/set-segment-interp h [:xform :pos] 0 :linear) 5)) "and back to a tween")
(is (= h (node/set-segment-interp h [:xform :pos] 10 :hold)) "the last key has no gap after it") (is (= h (node/set-segment-interp h [:xform :pos] 10 :hold)) "the last key has no gap after it")
(is (empty? (ch/problems (get-in h [:channels [:xform :pos]]))))) (is (empty? (ch/problems (get-in h [:channels [:xform :pos]])))))
(let [d (node/toggle-key (node/set-segment-interp c [:xform :pos] 0 :hold) [:xform :pos] 0)] (let [d (node/toggle-key (node/set-segment-interp c [:xform :pos] 0 :hold) [:xform :pos] 0 nil)]
(is (not (contains? (get-in d [:channels [:xform :pos] :segments]) 0)) (is (not (contains? (get-in d [:channels [:xform :pos] :segments]) 0))
"taking a key off takes its gap's choice with it")))) "taking a key off takes its gap's choice with it"))))

13
frontend/test/arthur/domain/paint_test.cljs
View file

@ -5,6 +5,7 @@
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.paint :as paint] [arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
(defn- geometry [clip] (defn- geometry [clip]
@ -22,13 +23,13 @@
node/set-segment-interp paint/geometry 9 :linear) node/set-segment-interp paint/geometry 9 :linear)
mixed (geometry mixed-clip)] mixed (geometry mixed-clip)]
(is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span]))) (is (= [3 229] (get-in c2 [:symbols :main :nodes :paint-test :span])))
(is (= a (channel/value-at held 8))) (is (= a (channel/value-at held 8 nil)))
(is (= 10 (first (channel/value-at held 8)))) (is (= 10 (first (channel/value-at held 8 nil))))
(is (= 22 (first (channel/value-at held 9)))) (is (= 22 (first (channel/value-at held 9 nil))))
(is (= 10 (first (channel/value-at mixed 6))) "the first gap cuts") (is (= 10 (first (channel/value-at mixed 6 nil))) "the first gap cuts")
(is (= 28 (first (channel/value-at mixed 12))) "the second gap tweens") (is (= 28 (first (channel/value-at mixed 12 nil))) "the second gap tweens")
(is (empty? (channel/problems mixed))) (is (empty? (channel/problems mixed)))
;; The demo's root is exposed on 2s. Paint at frame 3 must still appear at 3. ;; The demo's root is exposed on 2s. Paint at frame 3 must still appear at 3.
(is (some #(= :paint-test (:node %)) (is (some #(= :paint-test (:node %))
(symbol/eval-frame (get-in c2 [:symbols :main]) 3))) (symbol/eval-frame (get-in c2 [:symbols :main]) 3 nil pal/index-of nil nil)))
(is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip)))))) (is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip))))))

3
frontend/test/arthur/domain/project_test.cljs
View file

@ -21,6 +21,7 @@
[arthur.demo.take :as take] [arthur.demo.take :as take]
[arthur.domain.channel :as ch] [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.palette :as pal]
[arthur.domain.project :as project] [arthur.domain.project :as project]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.flow.freeze :as freeze] [arthur.flow.freeze :as freeze]
@ -147,7 +148,7 @@
;; frame rather than hidden, and its partner is not. ;; frame rather than hidden, and its partner is not.
(let [back (wired :c1 @gappy) (let [back (wired :c1 @gappy)
drawn (into #{} (map :node) drawn (into #{} (map :node)
((symbol/resolver (face-symbol (:clip back)) (:store back)) 12))] ((symbol/resolver (face-symbol (:clip back)) (:store back) pal/index-of nil nil) 12))]
(is (not (contains? drawn :eye-r))) (is (not (contains? drawn :eye-r)))
(is (contains? drawn :eye-l)) (is (contains? drawn :eye-l))
(is (contains? drawn :mouth)))) (is (contains? drawn :mouth))))

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

@ -27,7 +27,7 @@
{:nodes (into {} (map (juxt :id identity)) nodes)}) {:nodes (into {} (map (juxt :id identity)) nodes)})
(defn- ids-at [scene f] (defn- ids-at [scene f]
(mapv :node (symbol/eval-frame scene f))) (mapv :node (symbol/eval-frame scene f nil pal/index-of nil nil)))
(def ^:private pts-of ops/points) (def ^:private pts-of ops/points)
@ -70,9 +70,9 @@
(is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b])) (is (identical? (get-in s [:nodes :b]) (get-in s' [:nodes :b]))
"and so is the new one") "and so is the new one")
(is (= [[0 0] [10 0] [10 10]] (is (= [[0 0] [10 0] [10 10]]
(pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s 0)))))) (pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s 0 nil pal/index-of nil nil))))))
(is (= [[100 0] [110 0] [110 10]] (is (= [[100 0] [110 0] [110 10]]
(pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s' 0)))))))) (pts-of (first (filter #(= :c (:node %)) (symbol/eval-frame s' 0 nil pal/index-of nil nil))))))))
;; ---- draw order ---- ;; ---- draw order ----
@ -129,7 +129,7 @@
:channels {[:xform :pos] (ch/framed [100 50]) :channels {[:xform :pos] (ch/framed [100 50])
[:xform :scale] (ch/framed [2 2])}} [:xform :scale] (ch/framed [2 2])}}
(poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base)) (poly :p :g "a1" [0 0 10 0 10 10 0 10] :skin-base))
op (first (symbol/eval-frame s 0))] op (first (symbol/eval-frame s 0 nil pal/index-of nil nil))]
(is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op))))) (is (= [[100 50] [120 50] [120 70] [100 70]] (pts-of op)))))
(deftest a-keyed-group-position-moves-its-children-and-holds-between-keys (deftest a-keyed-group-position-moves-its-children-and-holds-between-keys
@ -137,9 +137,9 @@
;; group whose [:xform :pos] is keyed on four frames. ;; group whose [:xform :pos] is keyed on four frames.
(let [s (sc {:id :g :kind :group :z "a1" (let [s (sc {:id :g :kind :group :z "a1"
:channels {[:xform :pos] :channels {[:xform :pos]
(ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]})}} (ch/keyed {0 [0 0], 4 [10 0], 8 [10 10], 12 [0 10]} :hold)}}
(poly :p :g "a1" [0 0 2 0 2 2] :skin-base)) (poly :p :g "a1" [0 0 2 0 2 2] :skin-base))
at #(first (pts-of (first (symbol/eval-frame s %))))] at #(first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil nil))))]
(is (= [0 0] (at 0))) (is (= [0 0] (at 0)))
(is (= [0 0] (at 3)) "held") (is (= [0 0] (at 3)) "held")
(is (= [10 0] (at 4))) (is (= [10 0] (at 4)))
@ -154,17 +154,17 @@
;; odd frames against a mouth cutting on even ones reads as two performances. ;; odd frames against a mouth cutting on even ones reads as two performances.
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 3}} (let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 3}}
{:id :g :kind :group :parent :root :z "a1" {:id :g :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}} :channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)) :hold)}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base)) (poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (symbol/eval-frame s %)))))] x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil nil)))))]
(is (= [0 0 0 3 3 3 6 6 6 9 9 9] (mapv x-at (range 12))))) (is (= [0 0 0 3 3 3 6 6 6 9 9 9] (mapv x-at (range 12)))))
(testing "and a node may set its own grid, which the model permits deliberately" (testing "and a node may set its own grid, which the model permits deliberately"
(let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 2}} (let [s (sc {:id :root :kind :group :z "a1" :time {:mode :map :expose 2}}
{:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4} {:id :g :kind :group :parent :root :z "a1" :time {:mode :map :expose 4}
:channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)))}} :channels {[:xform :pos] (ch/keyed (into {} (map (juxt identity #(vector % 0))) (range 12)) :hold)}}
(poly :p :g "a1" [0 0 1 0 1 1] :skin-base)) (poly :p :g "a1" [0 0 1 0 1 1] :skin-base))
x-at #(first (first (pts-of (first (symbol/eval-frame s %)))))] x-at #(first (first (pts-of (first (symbol/eval-frame s % nil pal/index-of nil nil)))))]
(is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12))))))) (is (= [0 0 0 0 4 4 4 4 8 8 8 8] (mapv x-at (range 12)))))))
(deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead (deftest offset-is-per-node-which-is-the-entire-point-of-mouth-lead
@ -173,12 +173,12 @@
(let [keys (into {} (map (juxt identity #(vector % 0))) (range 12)) (let [keys (into {} (map (juxt identity #(vector % 0))) (range 12))
s (sc {:id :root :kind :group :z "a1"} s (sc {:id :root :kind :group :z "a1"}
{:id :plate :kind :group :parent :root :z "a1" {:id :plate :kind :group :parent :root :z "a1"
:channels {[:xform :pos] (ch/keyed keys)}} :channels {[:xform :pos] (ch/keyed keys :hold)}}
(poly :plate-p :plate "a1" [0 0 1 0 1 1] :skin-base) (poly :plate-p :plate "a1" [0 0 1 0 1 1] :skin-base)
{:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2} {:id :mouth :kind :group :parent :root :z "a2" :time {:mode :map :offset 2}
:channels {[:xform :pos] (ch/keyed keys)}} :channels {[:xform :pos] (ch/keyed keys :hold)}}
(poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark)) (poly :mouth-p :mouth "a1" [0 0 1 0 1 1] :mouth-dark))
x-of (fn [f id] (->> (symbol/eval-frame s f) x-of (fn [f id] (->> (symbol/eval-frame s f nil pal/index-of nil nil)
(filter #(= id (:node %))) first pts-of first first))] (filter #(= id (:node %))) first pts-of first first))]
(is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4)))) (is (= [0 1 2 3] (mapv #(x-of % :plate-p) (range 4))))
(is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead"))) (is (= [2 3 4 5] (mapv #(x-of % :mouth-p) (range 4))) "the mouth reads ahead")))
@ -194,12 +194,12 @@
{:span [2 5] {:span [2 5]
:channels {[:geom :pts] (ch/framed [0 0 1 0 1 1]) :channels {[:geom :pts] (ch/framed [0 0 1 0 1 1])
[:style :color] (ch/framed :brow) [:style :color] (ch/framed :brow)
[:vis] (ch/keyed {0 true, 3 false, 4 true})}}))] [:vis] (ch/keyed {0 true, 3 false, 4 true} :hold)}}))]
(is (= [[] [] [:p] [] [:p] [] []] (mapv #(ids-at s %) (range 7)))))) (is (= [[] [] [:p] [] [:p] [] []] (mapv #(ids-at s %) (range 7))))))
(deftest a-hidden-group-takes-its-children-with-it (deftest a-hidden-group-takes-its-children-with-it
(let [s (sc {:id :g :kind :group :z "a1" (let [s (sc {:id :g :kind :group :z "a1"
:channels {[:vis] (ch/keyed {0 true, 2 false})}} :channels {[:vis] (ch/keyed {0 true, 2 false} :hold)}}
(poly :p :g "a1" [0 0 1 0 1 1] :brow))] (poly :p :g "a1" [0 0 1 0 1 1] :brow))]
(is (= [:p] (ids-at s 0))) (is (= [:p] (ids-at s 0)))
(is (= [] (ids-at s 2))))) (is (= [] (ids-at s 2)))))
@ -221,11 +221,11 @@
:dense {:store "pts" :offset 0 :stride 6 :frames 2}} :dense {:store "pts" :offset 0 :stride 6 :frames 2}}
[:style :color] (ch/framed :mouth-dark)}} [:style :color] (ch/framed :mouth-dark)}}
(poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))] (poly :teeth :m "a2" [0 0 1 0 1 1] :teeth))]
(is (= [:child] (mapv :node (symbol/eval-frame absent-pos 0 store)))) (is (= [:child] (mapv :node (symbol/eval-frame absent-pos 0 store pal/index-of nil nil))))
(is (= [] (mapv :node (symbol/eval-frame absent-pos 1 store))) (is (= [] (mapv :node (symbol/eval-frame absent-pos 1 store pal/index-of nil nil)))
"an absent transform gives the children nowhere to be") "an absent transform gives the children nowhere to be")
(is (= [:m :teeth] (mapv :node (symbol/eval-frame absent-pts 0 store)))) (is (= [:m :teeth] (mapv :node (symbol/eval-frame absent-pts 0 store pal/index-of nil nil))))
(is (= [:teeth] (mapv :node (symbol/eval-frame absent-pts 1 store))) (is (= [:teeth] (mapv :node (symbol/eval-frame absent-pts 1 store pal/index-of nil nil)))
"an absent outline removes only itself"))) "an absent outline removes only itself")))
;; ---- stencils ---- ;; ---- stencils ----
@ -239,7 +239,7 @@
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2" {:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4) :channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}}) [:style :color] (ch/framed :iris)}})
ops (symbol/eval-frame s 0)] ops (symbol/eval-frame s 0 nil pal/index-of nil nil)]
(is (= [:sclera :iris] (mapv :node ops))) (is (= [:sclera :iris] (mapv :node ops)))
(is (= (:eye-white pal/index-of) (:stencil (second ops)))))) (is (= (:eye-white pal/index-of) (:stencil (second ops))))))
@ -250,7 +250,7 @@
(poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white (poly :sclera :root "a1" [0 0 10 0 10 10] :eye-white
{:channels {[:geom :pts] (ch/framed [0 0 10 0 10 10]) {:channels {[:geom :pts] (ch/framed [0 0 10 0 10 10])
[:style :color] (ch/framed :eye-white) [:style :color] (ch/framed :eye-white)
[:vis] (ch/keyed {0 true, 1 false})}}) [:vis] (ch/keyed {0 true, 1 false} :hold)}})
{:id :iris :kind :disc :parent :root :stencil :sclera :z "a2" {:id :iris :kind :disc :parent :root :stencil :sclera :z "a2"
:channels {[:geom :radius] (ch/framed 4) :channels {[:geom :radius] (ch/framed 4)
[:style :color] (ch/framed :iris)}})] [:style :color] (ch/framed :iris)}})]
@ -266,7 +266,7 @@
:channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}} :channels {[:geom :radius] (ch/framed 3) [:style :color] (ch/framed :iris)}}
{:id :r :kind :rect :parent :g :z "a2" {:id :r :kind :rect :parent :g :z "a2"
:channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}}) :channels {[:geom :size] (ch/framed 1.7) [:style :color] (ch/framed :pupil)}})
[d r] (symbol/eval-frame s 0)] [d r] (symbol/eval-frame s 0 nil pal/index-of nil nil)]
(is (= [50 60 6] [(:cx d) (:cy d) (:r d)])) (is (= [50 60 6] [(:cx d) (:cy d) (:r d)]))
(is (= 3.4 (:size r))))) (is (= 3.4 (:size r)))))
@ -291,7 +291,7 @@
(deftest the-resolver-reuses-one-buffer-per-node (deftest the-resolver-reuses-one-buffer-per-node
;; At 30fps per-frame allocation is the only thing that will make this stutter, ;; At 30fps per-frame allocation is the only thing that will make this stutter,
;; and fixed topology is what makes the buffer size knowable at all. ;; and fixed topology is what makes the buffer size knowable at all.
(let [res (symbol/resolver demo/main) (let [res (symbol/resolver demo/main nil pal/index-of nil nil)
buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))] buf-of (fn [f id] (->> (res f) (filter #(= id (:node %))) first :pts))]
(is (identical? (buf-of 0 :card) (buf-of 30 :card))))) (is (identical? (buf-of 0 :card) (buf-of 30 :card)))))
@ -308,15 +308,15 @@
;; The mistake this split makes easy: both are maps with an :id, and the wrong ;; The mistake this split makes easy: both are maps with an :id, and the wrong
;; one resolves to no ops rather than to an error. ;; one resolves to no ops rather than to an error.
(is (thrown-with-msg? ExceptionInfo #"not a symbol" (is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/resolver demo/clip))) (symbol/resolver demo/clip nil pal/index-of nil nil)))
(is (thrown-with-msg? ExceptionInfo #"not a symbol" (is (thrown-with-msg? ExceptionInfo #"not a symbol"
(symbol/eval-frame demo/clip 0))))) (symbol/eval-frame demo/clip 0 nil pal/index-of nil nil)))))
(deftest the-hand-written-clip-renders-and-moves (deftest the-hand-written-clip-renders-and-moves
;; port-plan step 2's done condition, as an assertion rather than a look: the ;; port-plan step 2's done condition, as an assertion rather than a look: the
;; scene rasterises, it writes only palette indices, and the pixels are not the ;; scene rasterises, it writes only palette indices, and the pixels are not the
;; same on every frame. ;; same on every frame.
(let [res (symbol/resolver demo/main) (let [res (symbol/resolver demo/main nil pal/index-of nil nil)
render (fn [f] render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))] (let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of)) (raster/clear! r (:bg pal/index-of))
@ -334,7 +334,7 @@
;; Exposure 2 on the clip root, inherited, so odd frames are identical to the ;; Exposure 2 on the clip root, inherited, so odd frames are identical to the
;; even frame before them. If this fails, exposure is being applied somewhere ;; even frame before them. If this fails, exposure is being applied somewhere
;; other than the frame the channels are sampled at. ;; other than the frame the channels are sampled at.
(let [res (symbol/resolver demo/main) (let [res (symbol/resolver demo/main nil pal/index-of nil nil)
render (fn [f] render (fn [f]
(let [r (raster/make (:width demo/clip) (:height demo/clip))] (let [r (raster/make (:width demo/clip) (:height demo/clip))]
(raster/clear! r (:bg pal/index-of)) (raster/clear! r (:bg pal/index-of))
@ -351,7 +351,7 @@
(deftest the-hand-written-clip-keeps-the-iris-and-pupil-inside-the-card (deftest the-hand-written-clip-keeps-the-iris-and-pupil-inside-the-card
;; The stencil chain, on real pixels: the iris is clipped by the card and the ;; The stencil chain, on real pixels: the iris is clipped by the card and the
;; pupil by the iris, and neither is expressed anywhere as a chain. ;; pupil by the iris, and neither is expressed anywhere as a chain.
(let [res (symbol/resolver demo/main)] (let [res (symbol/resolver demo/main nil pal/index-of nil nil)]
(doseq [f (range 0 demo/frames 4)] (doseq [f (range 0 demo/frames 4)]
(let [before (raster/make (:width demo/clip) (:height demo/clip)) (let [before (raster/make (:width demo/clip) (:height demo/clip))
after (raster/make (:width demo/clip) (:height demo/clip)) after (raster/make (:width demo/clip) (:height demo/clip))
@ -384,9 +384,9 @@
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base)) (poly :p :root "a1" [0 0 10 0 10 10] :skin-base))
day {:skin-base 1} day {:skin-base 1}
night {:skin-base 17}] night {:skin-base 17}]
(is (= 1 (:color (first (symbol/eval-frame s 0 nil day))))) (is (= 1 (:color (first (symbol/eval-frame s 0 nil day nil nil)))))
(is (= 17 (:color (first (symbol/eval-frame s 0 nil night))))) (is (= 17 (:color (first (symbol/eval-frame s 0 nil night nil nil)))))
(is (= 17 (:color (first ((symbol/resolver s nil night) 0)))) (is (= 17 (:color (first ((symbol/resolver s nil night nil nil) 0))))
"and the playback path agrees"))) "and the playback path agrees")))
(deftest a-tone-the-ramp-does-not-define-is-loudly-wrong (deftest a-tone-the-ramp-does-not-define-is-loudly-wrong
@ -394,7 +394,7 @@
;; authored data and should be impossible to miss. ;; authored data and should be impossible to miss.
(let [s (sc {:id :root :kind :group :z "a1"} (let [s (sc {:id :root :kind :group :z "a1"}
(poly :p :root "a1" [0 0 10 0 10 10] :skin-base))] (poly :p :root "a1" [0 0 10 0 10 10] :skin-base))]
(is (= 255 (:color (first (symbol/eval-frame s 0 nil {}))))))) (is (= 255 (:color (first (symbol/eval-frame s 0 nil {} nil nil)))))))
(deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil (deftest partitioning-the-index-space-stops-two-palettes-colliding-on-a-stencil
;; A stencil is a colour key, so two nodes sharing a tone share a stencil — ;; A stencil is a colour key, so two nodes sharing a tone share a stencil —
@ -407,6 +407,6 @@
[:style :color] (ch/framed :iris)}}) [:style :color] (ch/framed :iris)}})
;; :night's tones sit above :day's in one concatenated space ;; :night's tones sit above :day's in one concatenated space
night {:eye-white 14 :iris 15} night {:eye-white 14 :iris 15}
ops (symbol/eval-frame s 0 nil night)] ops (symbol/eval-frame s 0 nil night nil nil)]
(is (= 14 (:stencil (second ops))) (is (= 14 (:stencil (second ops)))
"the stencil resolves to the index the stencil node actually drew in"))) "the stencil resolves to the index the stencil node actually drew in")))

4
frontend/test/arthur/domain/trace_test.cljs
View file

@ -52,7 +52,7 @@
(defn- photo-at (defn- photo-at
"The photo matrix of face-1 alone at frame `f`, the still being 1000px tall." "The photo matrix of face-1 alone at frame `f`, the still being 1000px tall."
[c f] [c f]
(let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of) (let [r (symbol/resolver (clip/symbol c :face-1) @store pal/index-of nil nil)
h (head c)] h (head c)]
(r f) (r f)
(vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store (vec (array-seq (trace/photo-matrix (symbol/world-of r :head) h @store
@ -111,7 +111,7 @@
;; The same answer as `nest/placement`, which walks and resolves the path all ;; The same answer as `nest/placement`, which walks and resolves the path all
;; over again — the resolver has it already, from drawing the frame. ;; over again — the resolver has it already, from drawing the frame.
(let [c (wrapped) (let [c (wrapped)
r (clip/resolver c @store pal/index-of :wrap) r (clip/resolver c @store pal/index-of :wrap nil)
path [:m :face-1 :head]] path [:m :face-1 :head]]
(doseq [f [0 17 60]] (doseq [f [0 17 60]]
(r f) (r f)

8
frontend/test/arthur/domain/wire_test.cljs
View file

@ -13,10 +13,10 @@
;; THE reason this is transit. Keys are a map by FRAME, and `{"0" v}` is not ;; THE reason this is transit. Keys are a map by FRAME, and `{"0" v}` is not
;; `{0 v}`: `value-at` would find no key at frame 0 and the part would hold its ;; `{0 v}`: `value-at` would find no key at frame 0 and the part would hold its
;; first pose forever, on a document that looked fine. ;; first pose forever, on a document that looked fine.
(let [c (ch/keyed {0 true 4 false 12 true})] (let [c (ch/keyed {0 true 4 false 12 true} :hold)]
(is (= c (round c))) (is (= c (round c)))
(is (every? number? (keys (:keys (round c))))) (is (every? number? (keys (:keys (round c)))))
(is (= true (ch/value-at (round c) 13))))) (is (= true (ch/value-at (round c) 13 nil)))))
(deftest an-id-comes-back-a-keyword (deftest an-id-comes-back-a-keyword
(is (= {:id :mouth-in :kind :poly :parent :mouth :z "a2"} (is (= {:id :mouth-in :kind :poly :parent :mouth :z "a2"}
@ -35,7 +35,7 @@
;; Transit loses sortedness, which is why `domain/channel` says keys are a PLAIN ;; Transit loses sortedness, which is why `domain/channel` says keys are a PLAIN
;; map and builds the sorted index at read time. Asserted so that nobody ;; map and builds the sorted index at read time. Asserted so that nobody
;; "improves" the codec into a sorted map that works until the first round trip. ;; "improves" the codec into a sorted map that works until the first round trip.
(let [c (round (ch/keyed (into {} (map (juxt identity str)) (range 20))))] (let [c (round (ch/keyed (into {} (map (juxt identity str)) (range 20)) :hold))]
(is (map? (:keys c))) (is (map? (:keys c)))
(is (not (sorted? (:keys c)))) (is (not (sorted? (:keys c))))
(is (= (vec (range 20)) (ch/frames c))))) (is (= (vec (range 20)) (ch/frames c)))))
@ -50,7 +50,7 @@
;; turned `[]` into nil or into `[nil]` would either lose the field or refuse to ;; turned `[]` into nil or into `[nil]` would either lose the field or refuse to
;; play the document back. ;; play the document back.
(is (= {:over []} (round {:over []}))) (is (= {:over []} (round {:over []})))
(is (= [] (:over (round (ch/keyed {0 1})))))) (is (= [] (:over (round (ch/keyed {0 1} :hold))))))
(deftest a-whole-leaf-map-round-trips-through-parsed-json (deftest a-whole-leaf-map-round-trips-through-parsed-json
;; What a save actually does: transit, then parsed so the column holds JSON. ;; What a save actually does: transit, then parsed so the column holds JSON.

2
frontend/test/arthur/flow/eye_occlusion_test.cljs
View file

@ -59,7 +59,7 @@
(is (not (ch/nothing? (sample :eye-l f)))) (is (not (ch/nothing? (sample :eye-l f))))
(is (not (ch/nothing? (sample :mouth f))))) (is (not (ch/nothing? (sample :mouth f)))))
(let [drawn (into #{} (map :node) (let [drawn (into #{} (map :node)
((symbol/resolver (clip/symbol clip :face-1) store pal/index-of) 11))] ((symbol/resolver (clip/symbol clip :face-1) store pal/index-of nil nil) 11))]
(is (not (contains? drawn :eye-r))) (is (not (contains? drawn :eye-r)))
(is (not (contains? drawn :iris-r))) (is (not (contains? drawn :iris-r)))
(is (contains? drawn :eye-l)) (is (contains? drawn :eye-l))

29
frontend/test/arthur/flow/freeze_test.cljs
View file

@ -56,7 +56,7 @@
(defn- ops-at (defn- ops-at
"Ops for one frame of a TIMELINE." "Ops for one frame of a TIMELINE."
[sym f] [sym f]
((symbol/resolver sym @store pal/index-of) f)) ((symbol/resolver sym @store pal/index-of nil nil) f))
(defn- render (defn- render
"One frame of a CLIP into a byte buffer. The stage's size comes off the clip and "One frame of a CLIP into a byte buffer. The stage's size comes off the clip and
@ -64,7 +64,7 @@
[c f] [c f]
(let [r (raster/make (:width c) (:height c))] (let [r (raster/make (:width c) (:height c))]
(raster/clear! r (get pal/index-of :bg)) (raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r ((clip/resolver c @store pal/index-of :main) f)) (raster/draw-ops! r ((clip/resolver c @store pal/index-of :main nil) f))
(vec (array-seq (:buf r))))) (vec (array-seq (:buf r)))))
(defn- drawn (defn- drawn
@ -195,7 +195,7 @@
;; checking arithmetic against itself; this checks `node/local!`, `node/world!` ;; checking arithmetic against itself; this checks `node/local!`, `node/world!`
;; and `emit` as well. ;; and `emit` as well.
(let [c (freeze/head-mode {} @frozen) (let [c (freeze/head-mode {} @frozen)
res (clip/resolver c @store pal/index-of :main) res (clip/resolver c @store pal/index-of :main nil)
k (first (:value (chan :face [:xform :scale]))) k (first (:value (chan :face [:xform :scale])))
anc (:value (chan :face [:xform :anchor])) anc (:value (chan :face [:xform :anchor]))
pos (:value (chan :face [:xform :pos])) pos (:value (chan :face [:xform :pos]))
@ -250,13 +250,13 @@
(deftest trace-keys-hold-the-whole-measured-transform (deftest trace-keys-hold-the-whole-measured-transform
(let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen)) (let [free (symbol/resolver (face-symbol (freeze/head-mode {} @frozen))
@store pal/index-of) @store pal/index-of nil nil)
held (symbol/resolver (face-symbol held (symbol/resolver (face-symbol
(freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen)) (freeze/head-mode {:trace {:origin :keys :frames [12 88]}} @frozen))
@store pal/index-of) @store pal/index-of nil nil)
start (symbol/resolver (face-symbol start (symbol/resolver (face-symbol
(freeze/head-mode {:trace {:origin :start :frames [12 88]}} @frozen)) (freeze/head-mode {:trace {:origin :start :frames [12 88]}} @frozen))
@store pal/index-of) @store pal/index-of nil nil)
world (fn [resolver frame] world (fn [resolver frame]
(resolver frame) (resolver frame)
(vec (array-seq (symbol/world-of resolver :head))))] (vec (array-seq (symbol/world-of resolver :head))))]
@ -340,7 +340,8 @@
(is (= (nil? (gesture/refusal n)) (not (node/measured? n))) (is (= (nil? (gesture/refusal n)) (not (node/measured? n)))
(str sid "/" id ": `refusal` and `measured?` disagree")) (str sid "/" id ": `refusal` and `measured?` disagree"))
(when anchor (when anchor
(let [[x0 y0 x1 y1] (reduce #(let [k (pick/local-bounds c @store n %2)] (let [bounds (pick/bounds-of c @store n)
[x0 y0 x1 y1] (reduce #(let [k (bounds %2)]
(cond (nil? %1) k (nil? k) %1 (cond (nil? %1) k (nil? k) %1
:else (mapv (fn [op i] (op (nth %1 i) (nth k i))) :else (mapv (fn [op i] (op (nth %1 i) (nth k i)))
[min min max max] (range 4)))) [min min max max] (range 4))))
@ -432,7 +433,7 @@
peak (reduce max ap) peak (reduce max ap)
want (mapv #(>= (/ % peak) 0.12) ap)] want (mapv #(>= (/ % peak) 0.12) ap)]
(is (= :keyed (ch/describe c))) (is (= :keyed (ch/describe c)))
(is (= want (mapv #(ch/value-at c %) (range take/frames))) (is (= want (mapv #(ch/value-at c % nil) (range take/frames)))
"the held keys do not reproduce the threshold") "the held keys do not reproduce the threshold")
;; The reason it is keyed: a threshold crossing is a handful of transitions, ;; The reason it is keyed: a threshold crossing is a handful of transitions,
;; hold is the default, and keys are the shape a human can correct. A dense ;; hold is the default, and keys are the shape a human can correct. A dense
@ -510,7 +511,7 @@
(is (not (ch/nothing? (at :eye-r 60)))) (is (not (ch/nothing? (at :eye-r 60))))
(is (not (ch/nothing? (at :eye-l 50)))) (is (not (ch/nothing? (at :eye-l 50))))
(is (not (ch/nothing? (at :mouth 50)))) (is (not (ch/nothing? (at :mouth 50))))
(let [drawn-nodes (into #{} (map :node) ((symbol/resolver sym (:store c) pal/index-of) 50))] (let [drawn-nodes (into #{} (map :node) ((symbol/resolver sym (:store c) pal/index-of nil nil) 50))]
(is (not (contains? drawn-nodes :eye-r))) (is (not (contains? drawn-nodes :eye-r)))
(is (contains? drawn-nodes :eye-l)) (is (contains? drawn-nodes :eye-l))
(is (contains? drawn-nodes :mouth))) (is (contains? drawn-nodes :mouth)))
@ -585,7 +586,7 @@
;; Hoisted: the resolver caches its order and reuses its buffers, so the ;; Hoisted: the resolver caches its order and reuses its buffers, so the
;; node ids come out before the next frame is asked for. ;; node ids come out before the next frame is asked for.
nodes-at (fn [c] nodes-at (fn [c]
(let [r (symbol/resolver (face-symbol (:clip c)) (:store c) pal/index-of)] (let [r (symbol/resolver (face-symbol (:clip c)) (:store c) pal/index-of nil nil)]
(fn [f] (into #{} (map :node) (r f))))) (fn [f] (into #{} (map :node) (r f)))))
ref-at (nodes-at ref) ref-at (nodes-at ref)
occ-at (nodes-at occ) occ-at (nodes-at occ)
@ -622,7 +623,7 @@
c (freeze/clip (assoc take/params :name "gappy") c (freeze/clip (assoc take/params :name "gappy")
{:face-1 (assoc @take/measured :detected det)}) {:face-1 (assoc @take/measured :detected det)})
sym (face-symbol (:clip c)) sym (face-symbol (:clip c))
res (symbol/resolver sym (:store c) pal/index-of)] res (symbol/resolver sym (:store c) pal/index-of nil nil)]
(doseq [f [39 40 50 59 60]] (doseq [f [39 40 50 59 60]]
(let [ops (res f)] (let [ops (res f)]
(if (contains? gap f) (if (contains? gap f)
@ -631,9 +632,9 @@
;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is ;; And it is the MASK doing it, not a hidden flag: `[:vis]` on :mouth-in is
;; unchanged across the gap, because hiding and absence are different ;; unchanged across the gap, because hiding and absence are different
;; questions with different answers. ;; questions with different answers.
(is (= (mapv #(ch/value-at (get-in (:nodes sym) [:mouth-in :channels [:vis]]) %) (is (= (mapv #(ch/value-at (get-in (:nodes sym) [:mouth-in :channels [:vis]]) % nil)
(range take/frames)) (range take/frames))
(mapv #(ch/value-at (chan :mouth-in [:vis]) %) (range take/frames)))))) (mapv #(ch/value-at (chan :mouth-in [:vis]) % nil) (range take/frames))))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; the rings are still rings ;; the rings are still rings
@ -681,7 +682,7 @@
shot (fn [f] shot (fn [f]
(let [r (raster/make W H) (let [r (raster/make W H)
mouth (filter #(= [:face-1 :mouth] (:node %)) mouth (filter #(= [:face-1 :mouth] (:node %))
((clip/resolver locked @store pal/index-of :main) f))] ((clip/resolver locked @store pal/index-of :main nil) f))]
(raster/clear! r (get pal/index-of :bg)) (raster/clear! r (get pal/index-of :bg))
(raster/draw-ops! r mouth) (raster/draw-ops! r mouth)
(vec (array-seq (:buf r))))) (vec (array-seq (:buf r)))))

6
frontend/test/arthur/flow/multi_face_test.cljs
View file

@ -35,7 +35,7 @@
(defn channel [entry subject node path] (defn channel [entry subject node path]
(get-in entry [:clip :symbols subject :nodes node :channels path])) (get-in entry [:clip :symbols subject :nodes node :channels path]))
(defn snapshot [c store f] (ops/snapshot ((clip/resolver c store pal/index-of :main) f))) (defn snapshot [c store f] (ops/snapshot ((clip/resolver c store pal/index-of :main nil) f)))
(defn by-node [c store f] (into {} (map (juxt :node identity)) (snapshot c store f))) (defn by-node [c store f] (into {} (map (juxt :node identity)) (snapshot c store f)))
(deftest subjects-share-local-names-without-sharing-blocks (deftest subjects-share-local-names-without-sharing-blocks
@ -178,8 +178,8 @@
(merge (dissoc (:nodes (clip/symbol clip :main)) :face-1) (merge (dissoc (:nodes (clip/symbol clip :main)) :face-1)
(assoc-in (get-in clip [:symbols :face-1 :nodes]) (assoc-in (get-in clip [:symbols :face-1 :nodes])
[:head :parent] :face))) [:head :parent] :face)))
nested (clip/resolver clip store pal/index-of :main) nested (clip/resolver clip store pal/index-of :main nil)
reference (clip/resolver flat store pal/index-of :main)] reference (clip/resolver flat store pal/index-of :main nil)]
(doseq [f [0 1 7 20 39]] (doseq [f [0 1 7 20 39]]
(let [a (ops/snapshot (nested f)) b (ops/snapshot (reference f))] (let [a (ops/snapshot (nested f)) b (ops/snapshot (reference f))]
(is (= (mapv (comp second :node) a) (mapv :node b))) (is (= (mapv (comp second :node) a) (mapv :node b)))

4
frontend/test/arthur/support/ops.cljs
View file

@ -52,11 +52,11 @@
"(fn [f] -> snapshot) through `eval-frame`, the specification." "(fn [f] -> snapshot) through `eval-frame`, the specification."
([sym store] (specified sym store pal/index-of)) ([sym store] (specified sym store pal/index-of))
([sym store palette] ([sym store palette]
(fn [f] (snapshot (symbol/eval-frame sym f store palette))))) (fn [f] (snapshot (symbol/eval-frame sym f store palette nil nil)))))
(defn resolved (defn resolved
"(fn [f] -> snapshot) through `resolver`, the playback path." "(fn [f] -> snapshot) through `resolver`, the playback path."
([sym store] (resolved sym store pal/index-of)) ([sym store] (resolved sym store pal/index-of))
([sym store palette] ([sym store palette]
(let [res (symbol/resolver sym store palette)] (let [res (symbol/resolver sym store palette nil nil)]
(fn [f] (snapshot (res f)))))) (fn [f] (snapshot (res f))))))