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) 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) 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})}}
|
||
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)
|
||
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))
|
||
[: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]})))
|
||
{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) 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")))))
|