arthur/frontend/test/arthur/domain/node_test.cljs

(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 a-retimed-instance-is-refused-rather-than-ignored
  ;; :rate is a symbol instance's timing and symbols are out of scope. Silently
  ;; dropping it would be a retimed blink playing at the wrong speed, which looks
  ;; like a bad blink and not like a missing feature.
  (is (thrown-with-msg? ExceptionInfo #":rate"
                        (node/local-frame {:id :x :time {:mode :map :rate 0.5}} 0)))
  (is (= 4 (node/local-frame {:id :x :time {:mode :map :expose 2 :rate 1.0}} 5))
      "rate 1.0 is the identity and is allowed, because it appears in the spec's example"))

;; ---- the shape ----

(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)))
    (is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0)))
    (is (= true (ch/value-at (get chs [:vis]) 0))))
  (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)))
      (is (= [1.0 1.0] (ch/value-at (get chs [:xform :scale]) 0))))))

(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.
  (doseq [k node/implemented-kinds]
    (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"))

(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"))