228 lines
12 KiB
Clojure
228 lines
12 KiB
Clojure
(ns arthur.domain.node-test
|
||
"The transform and the time map. Both are places where a wrong answer looks
|
||
like a plausible different answer, which is why they are asserted numerically
|
||
rather than looked at."
|
||
(:require [cljs.test :refer [deftest is testing]]
|
||
[arthur.domain.channel :as ch]
|
||
[arthur.domain.node :as node]))
|
||
|
||
(defn- pt [m x y]
|
||
(let [out (js/Float64Array. 2)]
|
||
(node/apply-pt! out 0 m x y)
|
||
[(aget out 0) (aget out 1)]))
|
||
|
||
(defn- close? [a b] (< (js/Math.abs (- a b)) 1e-12))
|
||
(defn- close-pt? [[ax ay] [bx by]] (and (close? ax bx) (close? ay by)))
|
||
|
||
(defn- local [& {:keys [pos rot scale skew anchor]
|
||
:or {pos [0 0] rot 0 scale [1 1] skew [0 0] anchor [0 0]}}]
|
||
(node/local! (node/mat) pos rot scale skew anchor))
|
||
|
||
;; ---- the transform, component by component ----
|
||
|
||
(deftest the-identity-transform-moves-nothing
|
||
(is (= [5 7] (pt (local) 5 7))))
|
||
|
||
(deftest translation-rotation-and-scale-each-do-their-own-job
|
||
(is (= [15 27] (pt (local :pos [10 20]) 5 7)))
|
||
(is (close-pt? [0 10] (pt (local :rot (/ js/Math.PI 2)) 10 0)))
|
||
(is (= [20 21] (pt (local :scale [2 3]) 10 7))))
|
||
|
||
(deftest rotation-and-scale-happen-about-the-anchor
|
||
;; :anchor is Flash's registration point and Blender's origin. Getting it wrong
|
||
;; is why hand-placed parts SWING rather than turn, and a swing looks like a
|
||
;; parenting bug rather than like a wrong pivot.
|
||
(let [m (local :rot (/ js/Math.PI 2) :anchor [10 0])]
|
||
(is (close-pt? [10 0] (pt m 10 0)) "the anchor itself is a fixed point")
|
||
(is (close-pt? [10 10] (pt m 20 0)) "and the rest turns about it"))
|
||
(let [m (local :scale [2 2] :anchor [10 10])]
|
||
(is (close-pt? [10 10] (pt m 10 10)))
|
||
(is (close-pt? [30 30] (pt m 20 20)))))
|
||
|
||
(deftest skew-is-shear-factors-so-the-identity-is-zero
|
||
;; Stored as factors rather than angles: kx is x gained per unit y, so a
|
||
;; decomposition round-trips without a tangent, and 0 means "none" rather than
|
||
;; needing atan of something.
|
||
(is (= [5 7] (pt (local :skew [0 0]) 5 7)))
|
||
(is (= [12 7] (pt (local :skew [1 0]) 5 7)) "kx adds y into x")
|
||
(is (= [5 12] (pt (local :skew [0 1]) 5 7)) "ky adds x into y"))
|
||
|
||
(deftest the-composition-order-is-the-one-the-model-specifies
|
||
;; local = T(pos) · T(anchor) · R(rot) · K(skew) · S(scale) · T(-anchor)
|
||
;;
|
||
;; Asserted against the product of the five matrices built separately, so the
|
||
;; closed form in node/local! is checked rather than trusted. Every other order
|
||
;; produces a transform that is right at the origin and wrong everywhere else,
|
||
;; which is exactly the kind of wrong that survives inspection.
|
||
(let [pos [3 -4] rot 0.7 scale [1.5 0.5] skew [0.25 -0.1] anchor [11 -6]
|
||
T (fn [x y] (js/Float64Array. #js [1 0 0 1 x y]))
|
||
R (fn [t] (js/Float64Array. #js [(js/Math.cos t) (js/Math.sin t)
|
||
(- (js/Math.sin t)) (js/Math.cos t) 0 0]))
|
||
K (fn [[kx ky]] (js/Float64Array. #js [1 ky kx 1 0 0]))
|
||
S (fn [[sx sy]] (js/Float64Array. #js [sx 0 0 sy 0 0]))
|
||
step (fn [acc m] (node/mul! (node/mat) acc m))
|
||
want (reduce step (T (nth pos 0) (nth pos 1))
|
||
[(T (nth anchor 0) (nth anchor 1))
|
||
(R rot) (K skew) (S scale)
|
||
(T (- (nth anchor 0)) (- (nth anchor 1)))])
|
||
got (local :pos pos :rot rot :scale scale :skew skew :anchor anchor)]
|
||
(is (every? (fn [i] (close? (aget want i) (aget got i))) (range 6))
|
||
(str (vec (array-seq want)) " vs " (vec (array-seq got))))))
|
||
|
||
(deftest mul-may-write-into-either-operand
|
||
;; Evaluation composes world := parent · local with dest aliasing local, so
|
||
;; that a node's world transform needs no scratch. If mul! wrote before reading,
|
||
;; the bug would be a node in the right place whose CHILDREN are wrong.
|
||
(let [a (js/Float64Array. #js [2 0 0 3 5 7])
|
||
b (js/Float64Array. #js [1 0.5 -0.5 1 -2 4])
|
||
want (node/mul! (node/mat) a b)
|
||
into-b (node/mul! b a b)]
|
||
(is (= (vec (array-seq want)) (vec (array-seq into-b))))))
|
||
|
||
(deftest world-composes-through-the-parent
|
||
(let [parent (local :pos [100 50] :scale [2 2])
|
||
child (local :pos [10 0])
|
||
w (node/world! (node/mat) parent nil child (node/mat))]
|
||
(is (close-pt? [120 50] (pt w 0 0)))))
|
||
|
||
(deftest pinv-keeps-a-child-from-jumping-when-it-acquires-a-parent
|
||
;; Blender's parent_inverse. Nothing produces one yet; what is asserted is that
|
||
;; the field is in the composition, because its absence is the kind of thing
|
||
;; that makes a parenting feature feel broken and the fix is a migration.
|
||
(let [parent (local :pos [100 50])
|
||
child (local :pos [10 0])
|
||
before (pt child 0 0)
|
||
;; the inverse of the parent at the moment of parenting
|
||
pinv (js/Float64Array. #js [1 0 0 1 -100 -50])
|
||
after (pt (node/world! (node/mat) parent pinv child (node/mat)) 0 0)]
|
||
(is (close-pt? before after))))
|
||
|
||
(deftest mean-scale-is-exact-for-a-similarity
|
||
;; A disc under a non-uniform transform is an ellipse and the rasteriser has no
|
||
;; ellipse, so a disc's radius takes sqrt|det|. For the similarity the anchor
|
||
;; fit produces — the only transform that reaches a disc today — that is exact.
|
||
(is (close? 1.0 (node/mean-scale (local))))
|
||
(is (close? 3.0 (node/mean-scale (local :scale [3 3]))))
|
||
(is (close? 3.0 (node/mean-scale (local :scale [3 3] :rot 1.234)))
|
||
"and rotation does not change it"))
|
||
|
||
;; ---- time maps ----
|
||
|
||
(deftest exposure-floors-and-never-rounds
|
||
;; Rounding would let an output frame read a pose from the FUTURE, which is a
|
||
;; lead — a separate control, applied after this one, for a separate reason.
|
||
(is (= [0 1 2 3 4 5] (mapv #(node/expose % 1) (range 6))))
|
||
(is (= [0 0 2 2 4 4] (mapv #(node/expose % 2) (range 6))))
|
||
(is (= [0 0 0 3 3 3] (mapv #(node/expose % 3) (range 6))))
|
||
(is (= 4 (node/expose 5 2)) "frame 5 at exposure 2 reads frame 4, not 6"))
|
||
|
||
(deftest exposure-comes-before-offset-and-the-order-is-visible
|
||
;; THE INVARIANT: flooring onto a grid and shifting against the clock do not
|
||
;; commute. Shift first and the floor discards it on most frames, so the lead
|
||
;; slider appears to do nothing at any exposure above 1 — which is
|
||
;; indistinguishable from the slider being unwired.
|
||
(let [n {:id :m :time {:mode :map :expose 2 :offset 1}}
|
||
got (mapv #(node/local-frame n %) (range 8))
|
||
wrong-way (mapv #(node/expose (+ % 1) 2) (range 8))]
|
||
(is (= [1 1 3 3 5 5 7 7] got))
|
||
(is (= [0 2 2 4 4 6 6 8] wrong-way))
|
||
(is (not= got wrong-way) "and the two orders really do differ")))
|
||
|
||
(deftest inherit-is-the-default-and-changes-nothing
|
||
(is (= (vec (range 8)) (mapv #(node/local-frame {:id :x} %) (range 8))))
|
||
(is (= (vec (range 8)) (mapv #(node/local-frame {:id :x :time {:mode :inherit}} %) (range 8)))))
|
||
|
||
(deftest every-node-has-the-same-time-map
|
||
;; One rule, whatever the node is: `local = rate · (parent − at)`.
|
||
(is (= 5 (node/local-frame {:id :x :time {:mode :map :rate 0.5}} 10)) "a shape, at half speed")
|
||
(is (= 5 (node/local-frame {:id :x :kind :instance :time {:mode :map :rate 0.5}} 10)) "an instance, the same")
|
||
(is (= 3 (node/local-frame {:id :x :time {:mode :map :at 7}} 10)) "and :at is where its frame 0 lands")
|
||
(is (= 4 (node/local-frame {:id :x :time {:mode :map :expose 2 :rate 1.0}} 5))
|
||
"exposure still floors on its own clock")
|
||
(let [m {:at 3 :rate 2}]
|
||
(is (= {:at 0 :rate 1} (node/then-time m (node/invert-time m)))
|
||
"a map followed by its inverse is nothing")))
|
||
|
||
(deftest transform-channels-default-to-the-identity
|
||
(let [chs (node/channels {:id :x :kind :group})]
|
||
(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 nil)))
|
||
(is (= true (ch/value-at (get chs [:vis]) 0 nil))))
|
||
(testing "and a node's own channels win"
|
||
(let [chs (node/channels {:id :x :kind :group
|
||
:channels {[:xform :pos] (ch/framed [5 5])}})]
|
||
(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 nil))))))
|
||
|
||
(deftest skew-and-anchor-are-in-the-shape-although-nothing-drives-them
|
||
;; A decomposition is not extensible after the fact: adding a component later
|
||
;; means migrating every stored transform. So both are present from the start,
|
||
;; on every kind that is in the picture.
|
||
(doseq [k (disj node/implemented-kinds :audio)]
|
||
(is (contains? (get node/valid-paths k) [:xform :skew]) (str k))
|
||
(is (contains? (get node/valid-paths k) [:xform :anchor]) (str k))))
|
||
|
||
(deftest valid-paths-follow-from-the-kind
|
||
(is (contains? (:poly node/valid-paths) [:geom :pts]))
|
||
(is (not (contains? (:poly node/valid-paths) [:geom :radius])))
|
||
(is (contains? (:disc node/valid-paths) [:geom :radius]))
|
||
(is (contains? (:rect node/valid-paths) [:geom :size]))
|
||
(is (not (contains? (:group node/valid-paths) [:geom :pts]))
|
||
"a group is a pure transform node")
|
||
(is (= #{[:audio :gain] [:audio :pan] [:audio :rate]} (:audio node/valid-paths))
|
||
"a sound has no transform"))
|
||
|
||
(deftest a-sound-defaults-to-its-own-channels
|
||
(is (= (set (keys node/audio-defaults))
|
||
(set (keys (node/channels {:id :s :kind :audio}))))))
|
||
|
||
(deftest problems-names-the-ways-a-node-is-malformed
|
||
(is (empty? (node/problems {:id :x :kind :group :z "a1"})))
|
||
(is (seq (node/problems {:kind :group :z "a1"})) "no :id")
|
||
(is (seq (node/problems {:id :x :kind :blob :z "a1"})) "not a kind")
|
||
(is (seq (node/problems {:id :x :kind :instance :z "a1"})) "a kind that is not built")
|
||
(is (seq (node/problems {:id :x :kind :group})) "no :z")
|
||
(is (seq (node/problems {:id :x :kind :group :z "a1" :span [3]})) "a malformed span")
|
||
(is (seq (node/problems {:id :x :kind :group :z "a1"
|
||
:channels {[:geom :pts] (ch/framed [0 0 1 0 1 1])}}))
|
||
"a channel that is not valid on this kind")
|
||
(is (seq (node/problems {:id :x :kind :poly :z "a1"
|
||
:channels {[:geom :pts] {:animated? true}}}))
|
||
"and a channel that is malformed in itself"))
|
||
|
||
(deftest keying-a-channel-from-the-inspector
|
||
(let [n {:id :x :kind :group}
|
||
a (node/set-channel n [:xform :rot] 3 1.0)
|
||
b (node/toggle-key a [:xform :rot] 3 nil)
|
||
c (-> b (node/set-channel [:xform :pos] 9 [5 5])
|
||
(node/toggle-key [:xform :pos] 0 nil)
|
||
(node/set-channel [:xform :pos] 10 [10 0]))
|
||
rot #(ch/value-at (get (node/channels %1) [:xform :rot]) %2 nil)
|
||
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 (= {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 (= 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 nil)]
|
||
(is (not (:animated? (get-in d [:channels [:xform :rot]]))) "the last key off is one value again")
|
||
(is (= 1.0 (rot d 0))))
|
||
(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)]
|
||
(is (= [5 5] (pos h 5)) "a gap set to hold cuts at the next key")
|
||
(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 (= 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]])))))
|
||
(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))
|
||
"taking a key off takes its gap's choice with it"))))
|
||
|
||
(deftest auto-keying-a-channel-from-a-parameter-edit
|
||
(let [n {:id :x :kind :group}
|
||
keyed (node/set-keyed-channel n [:xform :rot] 7 1.25)
|
||
moved (node/set-keyed-channel keyed [:xform :rot] 11 2.5)
|
||
visible (node/set-keyed-channel n [:vis] 7 false)]
|
||
(is (= {7 1.25, 11 2.5} (get-in moved [:channels [:xform :rot] :keys])))
|
||
(is (= :linear (get-in moved [:channels [:xform :rot] :interp])))
|
||
(is (= :hold (get-in visible [:channels [:vis] :interp]))
|
||
"boolean parameters do not tween")))
|