ee66680a0c
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>
263 lines
15 KiB
Clojure
263 lines
15 KiB
Clojure
(ns arthur.domain.nest-test
|
||
(:require [cljs.test :refer [deftest is testing]]
|
||
[arthur.domain.channel :as ch]
|
||
[arthur.domain.clip :as clip]
|
||
[arthur.domain.nest :as nest]
|
||
[arthur.domain.node :as node]
|
||
[arthur.domain.paint :as paint]
|
||
[arthur.domain.palette :as pal]))
|
||
|
||
(defn- nested
|
||
"Three symbols: :outer places :inner, and :loose is placed by nothing."
|
||
[]
|
||
(-> (clip/blank)
|
||
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
|
||
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
|
||
(assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}})
|
||
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil)))
|
||
|
||
(deftest a-frame-is-carried-down-through-the-instances-a-row-path-names
|
||
(let [c (nested)
|
||
[id] (keys (get-in c [:symbols :outer :nodes]))
|
||
at #(select-keys (nest/inside c nil :outer %1 %2) [:sid :frame])]
|
||
(is (= {:sid :outer :frame 12} (at [] 12)))
|
||
(is (= {:sid :inner :frame 7} (at [id] 12))
|
||
"the instance starts at 5, so frame 12 outside is frame 7 inside")
|
||
(is (nil? (nest/inside c nil :outer [id] 2))
|
||
"and before it starts there is no inside to be in")))
|
||
|
||
(deftest a-shape-drawn-into-an-instance-lands-where-it-was-drawn
|
||
(let [u #uuid "00000000-0000-4000-8000-0000000000dd"
|
||
c (-> (clip/blank)
|
||
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
|
||
(clip/place-symbol nil :main :box 10 u nil)
|
||
;; moved, turned and doubled, so nothing lines up by accident
|
||
(update-in [:symbols :main :nodes u :channels] merge
|
||
{[:xform :pos] (ch/framed [40 20])
|
||
[:xform :rot] (ch/framed (/ js/Math.PI 2))
|
||
[:xform :scale] (ch/framed [2 2])}))
|
||
drawn [100 50 140 50 120 90]
|
||
{:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn)
|
||
c (paint/new-shape c sid :shape frame pts :brow)
|
||
[op] (filter #(= [u :shape] (:node %))
|
||
((clip/resolver c nil pal/index-of :main nil) 16))]
|
||
(is (= :box sid))
|
||
(is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10")
|
||
(is (every? #(< (js/Math.abs %) 1e-9)
|
||
(map - drawn (take 6 (array-seq (:pts op)))))
|
||
"resolved back out through the instance, it is exactly what was drawn")))
|
||
|
||
(deftest a-shape-two-instances-down-is-edited-where-it-is-seen
|
||
(let [u #uuid "00000000-0000-4000-8000-0000000000d1"
|
||
v #uuid "00000000-0000-4000-8000-0000000000d2"
|
||
turn (fn [c host id pos rot k]
|
||
(update-in c [:symbols host :nodes id :channels] merge
|
||
{[:xform :pos] (ch/framed pos)
|
||
[:xform :rot] (ch/framed rot)
|
||
[:xform :scale] (ch/framed [k k])}))
|
||
c (-> (clip/blank)
|
||
(assoc-in [:symbols :mid] {:id :mid :frames 40 :nodes {}})
|
||
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
|
||
(clip/place-symbol nil :main :mid 10 u nil)
|
||
(clip/place-symbol nil :mid :box 2 v nil)
|
||
(turn :main u [40 20] (/ js/Math.PI 2) 2)
|
||
(turn :mid v [5 -3] 0.3 1.5)
|
||
(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)))
|
||
((clip/resolver % nil pal/index-of :main nil) 16))))))
|
||
{:keys [frame matrix time]} (nest/inside c nil :main [u v :shape] 16)
|
||
out (js/Float64Array. 2)
|
||
seen (mapcat (fn [[x y]] (vec (array-seq (node/apply-pt! out 0 matrix x y))))
|
||
(partition 2 [0 0 10 0 5 10]))
|
||
[x y] (array-seq (node/apply-pt! out 0 (node/invert matrix) 7 3))
|
||
moved (paint/set-vertex c :box :shape frame 0 [x y])
|
||
keyed (paint/add-key c :box :shape (:frame (nest/inside c nil :main [u v :shape] 20)))]
|
||
(is (= 4 frame) "16 of main is 6 of mid, which is 4 of box and of the shape in it")
|
||
(is (= {:at 12 :rate 1} time))
|
||
(is (= #{4 8} (set (keys (get-in keyed [:symbols :box :nodes :shape :channels paint/geometry :keys]))))
|
||
"a key added at 20 of main lands at 8, the shape's own time")
|
||
(is (nil? (nest/inside c nil :main [u v :shape] 13))
|
||
"and where the shape is not on screen there is nothing to edit")
|
||
(is (every? #(< (js/Math.abs %) 1e-9) (map - (draw c) seen))
|
||
"the handles sit on what the stage draws")
|
||
(is (every? #(< (js/Math.abs %) 1e-9) (map - [7 3] (take 2 (draw moved))))
|
||
"and a vertex dragged to (7, 3) is drawn at (7, 3)")))
|
||
|
||
(deftest a-placed-symbols-sound-is-heard-where-it-is-placed
|
||
(let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1"
|
||
:span [10 40] :time {:mode :map :at -10 :rate 1}
|
||
:channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0} :hold)}}
|
||
c (-> (clip/blank)
|
||
(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))
|
||
[t] (nest/audio-tracks c :main)]
|
||
(is (= [10 40] (:span t)) "the same frames of the source")
|
||
(is (= [50 80] (node/placed-span t)) "starting where the instance starts")
|
||
(is (= #{50 55} (set (keys (get-in t [:channels [:audio :gain] :keys]))))
|
||
"with its automation moved along")
|
||
(testing "and cut off where the instance's own span ends"
|
||
(let [c (assoc-in c [:symbols :main :nodes #uuid "00000000-0000-4000-8000-0000000000bb" :span] [0 12])
|
||
[t] (nest/audio-tracks c :main)]
|
||
(is (= [10 22] (:span t)))
|
||
(is (= [50 62] (node/placed-span t)))))))
|
||
|
||
(defn- picture
|
||
"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."
|
||
[c sid fs]
|
||
(let [resolve (clip/resolver c nil pal/index-of sid nil)
|
||
round #(/ (js/Math.round (* 1000 %)) 1000)]
|
||
(mapv (fn [f]
|
||
(sort-by str (map (fn [op]
|
||
[(:color op) (mapv round (take (* 2 (:n op)) (array-seq (:pts op))))])
|
||
(resolve f))))
|
||
fs)))
|
||
|
||
(def ^:private a-uuid #uuid "00000000-0000-4000-8000-0000000000e1")
|
||
(def ^:private b-uuid #uuid "00000000-0000-4000-8000-0000000000e2")
|
||
|
||
(defn- studio
|
||
"`main` holds a keyed shape and a moved, turned, doubled instance of `box`,
|
||
placed at frame 10; `box` holds a shape of its own."
|
||
[]
|
||
(let [tri (fn [id x keyed]
|
||
{: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) :hold)
|
||
[:style :color] (ch/framed :brow)}})]
|
||
(-> (clip/blank)
|
||
(assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40}))
|
||
(assoc-in [:symbols :box] {:id :box :frames 50 :nodes {:inner (tri :inner 5 {0 10})}})
|
||
(clip/place-symbol nil :main :box 10 a-uuid nil)
|
||
(update-in [:symbols :main :nodes a-uuid :channels] merge
|
||
{[:xform :pos] (ch/framed [30 20])
|
||
[:xform :rot] (ch/framed 0.5)
|
||
[:xform :scale] (ch/framed [2 2])}))))
|
||
|
||
(deftest moving-a-node-into-a-symbol-changes-nothing-on-screen
|
||
;; From frame 10, where the instance starts: inside a symbol a node exists only
|
||
;; while that symbol is on screen, so moving the shape in cuts off 4–9.
|
||
(let [c (studio)
|
||
fs [10 16 29 30 45 59 60 70]
|
||
{moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)]
|
||
(is (nil? (:refused r)) (:refused r))
|
||
(is (contains? (get-in moved [:symbols :box :nodes]) :tri) "it is in the symbol now")
|
||
(is (not (contains? (get-in moved [:symbols :main :nodes]) :tri)) "and not beside it")
|
||
(is (= [4 60] (get-in moved [:symbols :box :nodes :tri :span]))
|
||
"its span and keys are its own and do not change")
|
||
(is (= -10 (get-in moved [:symbols :box :nodes :tri :time :at]))
|
||
"its time map takes up the ten frames the instance starts late")
|
||
(is (= (picture c :main fs) (picture moved :main fs)) "and the picture is the same, frame for frame")
|
||
(testing "moving it back out is also invisible"
|
||
(let [{back :clip} (nest/move-node moved nil :main [a-uuid :tri] [] 16)]
|
||
(is (= (picture c :main fs) (picture back :main fs)))))))
|
||
|
||
(deftest moving-an-instance-moves-only-its-at
|
||
(let [c (-> (studio)
|
||
(assoc-in [:symbols :holder] {:id :holder :frames 100 :nodes {}})
|
||
(clip/place-symbol nil :main :holder 3 b-uuid nil))
|
||
fs [0 10 16 40 59]
|
||
{moved :clip :as r} (nest/move-node c nil :main [a-uuid] [b-uuid] 16)
|
||
n (get-in moved [:symbols :holder :nodes a-uuid])]
|
||
(is (nil? (:refused r)) (:refused r))
|
||
(is (= 7 (get-in n [:time :at])) "placed at 10 in main is at 7 inside something placed at 3")
|
||
(is (= [0 50] (:span n)) "its own frames do not move")
|
||
(is (= (picture c :main fs) (picture moved :main fs)))))
|
||
|
||
(deftest grouping-makes-a-symbol-around-them-and-changes-nothing-on-screen
|
||
(let [c (studio)
|
||
fs [0 4 10 16 30 59 60]
|
||
{grouped :clip :as r} (nest/group c nil :main [[:tri] [a-uuid]] :group-1 b-uuid 16)
|
||
inst (get-in grouped [:symbols :main :nodes b-uuid])]
|
||
(is (nil? (:refused r)) (:refused r))
|
||
(is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes])))))
|
||
(is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were")
|
||
(is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts")
|
||
(is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends")
|
||
(is (= (picture c :main fs) (picture grouped :main fs)))
|
||
(is (empty? (clip/problems grouped)))))
|
||
|
||
(deftest what-cannot-move-says-why
|
||
(let [c (studio)]
|
||
(is (:refused (nest/move-node c nil :main [a-uuid] [a-uuid] 16)) "not into itself")
|
||
(is (:refused (nest/move-node c nil :main [:tri] [a-uuid] 2)) "not while the target is off screen")
|
||
(let [roto (assoc-in c [:symbols :main :nodes :tri :channels [:geom :pts] :generated] {:by :roto})]
|
||
(is (re-find #"generated" (:refused (nest/move-node roto nil :main [:tri] [a-uuid] 16)))))))
|
||
|
||
(deftest moving-into-a-retimed-instance-keeps-the-timing
|
||
(let [c (assoc-in (studio) [:symbols :main :nodes a-uuid :time :rate] 2)
|
||
fs [10 12 17 20 29 34]
|
||
{moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)]
|
||
(is (nil? (:refused r)) (:refused r))
|
||
(is (= {:at -20 :rate 0.5}
|
||
(select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate]))
|
||
"half speed inside something at double speed, so it runs as it did")
|
||
(is (= (picture c :main fs) (picture moved :main fs)))))
|
||
|
||
(deftest sliding-a-shape-inside-a-retimed-instance-moves-it-by-frames-of-the-open-symbol
|
||
;; `box` runs at double speed from 10, so six frames of main are twelve of box.
|
||
(let [c (-> (studio)
|
||
(update-in [:symbols :main :nodes] dissoc :tri)
|
||
(assoc-in [:symbols :main :nodes a-uuid :time :rate] 2)
|
||
(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]} :hold)))
|
||
{slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6)
|
||
fs [13 15 18 20]]
|
||
(is (nil? (:refused r)) (:refused r))
|
||
(is (= {:mode :map :at 12 :rate 1} (get-in slid [:symbols :box :nodes :inner :time])))
|
||
(is (= [4 60] (get-in slid [:symbols :box :nodes :inner :span])) "its span and keys are its own")
|
||
(is (= (picture c :main fs) (picture slid :main (map #(+ 6 %) fs)))
|
||
"what it did at a frame of main it now does six frames later")
|
||
(is (seq (first (picture c :main [14]))))
|
||
(is (empty? (first (picture slid :main [14]))) "and it is not there yet where it was")
|
||
(testing "sliding it again adds to where it is"
|
||
(is (= 2 (get-in (:clip (nest/slide slid :main [a-uuid :inner] -5))
|
||
[:symbols :box :nodes :inner :time :at]))))))
|
||
|
||
(deftest sliding-needs-nothing-on-screen-and-refuses-only-a-loop
|
||
(let [c (studio)]
|
||
(is (= 3 (get-in (:clip (nest/slide c :main [a-uuid :inner] 3))
|
||
[:symbols :box :nodes :inner :time :at]))
|
||
"the instance starts at 10, and where the playhead is has nothing to do with it")
|
||
(is (:refused (nest/slide (assoc-in c [:symbols :main :nodes a-uuid :time :loop?] true)
|
||
:main [a-uuid :inner] 3))
|
||
"but through a loop one frame outside is many inside")))
|
||
|
||
(deftest restacking-is-one-write-to-z
|
||
(let [shape (fn [z] {:kind :poly :z z :channels {}})
|
||
c (-> (clip/blank)
|
||
(assoc-in [:symbols :main :nodes] {:a (shape "a1") :b (shape "a2") :c (shape "a3")}))
|
||
order (fn [c] (map key (sort-by (comp :z val) (get-in c [:symbols :main :nodes]))))
|
||
front (:clip (nest/restack c :main [:a] [:c] true))
|
||
back (:clip (nest/restack c :main [:c] [:a] false))
|
||
mid (:clip (nest/restack c :main [:a] [:b] true))]
|
||
(is (= [:b :c :a] (order front)) "in front of the front one")
|
||
(is (= [:c :a :b] (order back)) "behind the back one")
|
||
(is (= [:b :a :c] (order mid)) "between two")
|
||
(is (= (dissoc (get-in c [:symbols :main :nodes]) :a)
|
||
(dissoc (get-in mid [:symbols :main :nodes]) :a))
|
||
"and nothing else is renumbered")
|
||
(is (:refused (nest/restack c :main [:a] [a-uuid :inner] true))
|
||
"only among the things it is beside")))
|
||
|
||
(deftest a-sound-dropped-in-a-placed-symbol-is-heard-where-the-placement-puts-it
|
||
(let [u #uuid "00000000-0000-4000-8000-0000000000a1"
|
||
c (-> (nested)
|
||
(clip/place-sound :inner {:sound "tone"} "tone.mp3" 40 1 2 u))
|
||
sound (get-in c [:symbols :inner :nodes u])
|
||
[heard] (nest/audio-tracks c :outer)]
|
||
(is (empty? (node/problems sound)) "a sound needs no transform")
|
||
(is (= {:sound "tone"} (:source sound)))
|
||
(is (= #{[:audio :gain] [:audio :pan] [:audio :rate]} (set (keys (node/channels sound)))))
|
||
(is (= [0 8] (:span heard))
|
||
"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 (empty? ((clip/resolver c nil pal/index-of :inner nil) 3))
|
||
"and it draws nothing")
|
||
(is (= c (clip/place-sound c :inner {:sound "tone"} "tone.mp3" 40 1 10 (random-uuid)))
|
||
"nor lands past the end of its symbol")
|
||
(testing "a video's own sound keeps its length at another rate"
|
||
(let [v (-> (nested)
|
||
(clip/place-sound :outer {:footage "f"} "take" 90 2.5 0 u)
|
||
(get-in [:symbols :outer :nodes u]))]
|
||
(is (empty? (node/problems v)))
|
||
(is (= [0 36] (node/placed-span v)) "90 frames at 30 are 36 at 12")))))
|