364 lines
21 KiB
Clojure
364 lines
21 KiB
Clojure
(ns arthur.domain.instance-test
|
|
(:require [cljs.test :refer [deftest is testing]]
|
|
[arthur.demo.stage :as stage]
|
|
[arthur.domain.channel :as ch]
|
|
[arthur.domain.clip :as clip]
|
|
[arthur.domain.leaf :as leaf]
|
|
[arthur.domain.node :as node]
|
|
[arthur.domain.paint :as paint]
|
|
[arthur.domain.pose :as pose]
|
|
[arthur.domain.palette :as pal]
|
|
[arthur.domain.symbol :as symbol]))
|
|
|
|
(def source
|
|
{:name "source" :fps 30 :width 320 :height 200
|
|
:symbols
|
|
{:main {:id :main :frames 4
|
|
:nodes {:root {:id :root :kind :group :z "a1"}
|
|
:mark {:id :mark :kind :rect :parent :root :z "a1"
|
|
:channels {[:xform :pos] (ch/keyed {0 [0 0] 1 [10 0]
|
|
2 [20 0] 3 [30 0]} :hold)
|
|
[:geom :size] (ch/framed 4)
|
|
[:style :color] (ch/framed :brow)}}}}}})
|
|
|
|
(deftest two-instances-own-their-frame-and-placement
|
|
(let [document
|
|
(-> source
|
|
(assoc-in [:symbols :main]
|
|
{:id :main :frames 6
|
|
:nodes {:root {:id :root :kind :group :z "a1"}
|
|
:left {:id :left :kind :instance
|
|
:parent :root :z "a1" :span [0 4]
|
|
:source {:symbol :sym/test}
|
|
:channels {[:xform :pos] (ch/framed [100 50])}}
|
|
:right {:id :right :kind :instance
|
|
:parent :root :z "a2" :span [0 4]
|
|
:time {:mode :map :at 2 :rate 1}
|
|
:source {:symbol :sym/test}
|
|
:channels {[:xform :pos] (ch/framed [120 50])}}}})
|
|
(assoc-in [:symbols :sym/test]
|
|
(assoc (get-in source [:symbols :main]) :id :sym/test)))
|
|
resolve (clip/resolver document :main nil pal/index-of nil)
|
|
at (fn [f] (mapv (juxt :node :cx) (resolve f)))]
|
|
(is (empty? (clip/problems document)))
|
|
(is (= [[[:left :mark] 110]] (at 1)))
|
|
(is (= [[[:left :mark] 120] [[:right :mark] 120]] (at 2)))
|
|
(is (= [[[:right :mark] 150]] (at 5)))
|
|
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
|
|
|
|
(deftest a-placement-holds-and-cuts-each-generated-shape-independently
|
|
(let [values (js/Int16Array. (clj->js (range 2 32)))
|
|
visible (ch/keyed {0 true 20 true 21 false} :hold)
|
|
dense {:animated? true :interp :hold
|
|
:dense {:store "sizes" :offset 0 :stride 1 :frames 30}
|
|
:pose-sampled? true
|
|
:over [(ch/layer :nudge [7 8] :offset (ch/framed 100))]}
|
|
shape (fn [id z group]
|
|
{:id id :kind :rect :parent :root :z z :pose-group group
|
|
:channels {[:xform :pos] (ch/keyed {0 [0 0] 8 [8 0]} :hold)
|
|
[:geom :size] dense
|
|
[:vis] (assoc visible :pose-sampled? true)
|
|
[:style :color] (ch/framed :brow)}})
|
|
symbol {:id :sym/poses :frames 30
|
|
:nodes {:root {:id :root :kind :group :z "a1"}
|
|
:mouth (shape :mouth "a1" :mouth)
|
|
:mouth-detail (shape :mouth-detail "a2" :mouth)
|
|
:eye (shape :eye "a3" :eye)
|
|
:brow (shape :brow "a4" :brow)}}
|
|
document {:fps 30 :width 320 :height 200
|
|
:symbols
|
|
{:main {:id :main :frames 30
|
|
:nodes {:root {:id :root :kind :group :z "a1"}
|
|
:first {:id :first :kind :instance
|
|
:parent :root :z "a1"
|
|
:source {:symbol :sym/poses}
|
|
:playback {:tracks {:mouth {0 0, 8 20, 9 21}
|
|
[:node :mouth-detail] {0 0, 8 4}
|
|
:eye {0 0, 4 4}}}}
|
|
:second {:id :second :kind :instance
|
|
:parent :root :z "a2"
|
|
:source {:symbol :sym/poses}
|
|
:playback {:tracks {:mouth {0 0, 8 8}}}}}}
|
|
:sym/poses symbol}}
|
|
store {"sizes" {:data values}}
|
|
resolve (clip/resolver document :main store pal/index-of nil)
|
|
at (fn [f] (into {} (map (fn [op] [(:node op) op])) (resolve f)))]
|
|
(is (empty? (clip/problems document)))
|
|
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
|
|
(is (= 102 (:size (get (at 7) [:first :mouth]))) "eight static frames, plus its correction")
|
|
(is (= 22 (:size (get (at 8) [:first :mouth]))) "cut to source pose 20")
|
|
(is (= 6 (:size (get (at 8) [:first :mouth-detail])))
|
|
"one node may depart from its shared mouth group")
|
|
(is (= 10 (:size (get (at 8) [:second :mouth]))) "other instance chooses pose 8")
|
|
(is (= 106 (:size (get (at 7) [:first :eye]))) "eye has its own timing")
|
|
(is (= 8 (:cx (get (at 8) [:first :eye]))) "authored position still reads stage time")
|
|
(is (nil? (get (at 9) [:first :mouth]))
|
|
"generated visibility is read from the same selected pose")
|
|
(is (some? (get (at 9) [:second :mouth])))
|
|
(let [sym (get-in document [:symbols :sym/poses])
|
|
opts {:pose-tracks {:mouth {0 0, 8 20}}}]
|
|
(is (= (mapv #(select-keys % [:node :cx :size])
|
|
(symbol/eval-frame sym 8 store pal/index-of opts))
|
|
(mapv #(select-keys % [:node :cx :size])
|
|
((symbol/resolver sym store pal/index-of opts) 8)))
|
|
"pure evaluation and playback apply the same pose choice"))))
|
|
|
|
(deftest stage-pose-edits-preserve-earlier-motion-and-survive-save
|
|
(let [document (-> source
|
|
(assoc-in [:symbols :main :nodes :placed]
|
|
{:id :placed :kind :instance :parent :root
|
|
:z "a2"
|
|
:source {:symbol :sym/test}})
|
|
(assoc-in [:symbols :sym/test]
|
|
{:id :sym/test :frames 4
|
|
:nodes {:root {:id :root :kind :group :z "a1"}
|
|
:mark {:id :mark :kind :rect :parent :root
|
|
:z "a1" :pose-group :mark
|
|
:channels {[:geom :size]
|
|
{:animated? true :interp :hold
|
|
:keys {0 2 1 3 2 4 3 5}
|
|
:pose-sampled? true}}}}})
|
|
(pose/put-cut :main :placed :mark 2 3))
|
|
cuts (get-in document [:symbols :main :nodes :placed :playback :tracks :mark])]
|
|
(is (= {2 3} cuts))
|
|
(is (= 1 (pose/source-frame (pose/prepare {:mark cuts}) :mark 1 1))
|
|
"before the first cut, dense motion continues")
|
|
(is (= 3 (pose/source-frame (pose/prepare {:mark cuts}) :mark 2 2)))
|
|
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))
|
|
(is (nil? (get-in (pose/remove-cut document :main :placed :mark 2)
|
|
[:symbols :main :nodes :placed :playback :tracks :mark])))
|
|
(is (seq (clip/problems (assoc-in document
|
|
[:symbols :main :nodes :placed :playback :tracks :mark]
|
|
{4 3}))))))
|
|
|
|
(defn- uuid-of
|
|
"The uuid the layout authors for the placement whose handle is `id`.
|
|
|
|
Read out of `stage/layout` rather than written here as a literal: what this test
|
|
is about is the mapping `compose` performs, and nine copied uuids would assert
|
|
that someone copied them correctly."
|
|
[id]
|
|
(or (->> (concat (:instances stage/layout) (:audio stage/layout))
|
|
(some (fn [p] (when (= id (:id p)) (:uuid p)))))
|
|
(throw (ex-info "no such placement in the layout" {:id id}))))
|
|
|
|
(defn- placement
|
|
"The composed node for the placement the layout calls `id`."
|
|
[document id]
|
|
(get-in document [:symbols :main :nodes (uuid-of id)]))
|
|
|
|
(deftest stage-fixture-keeps-source-as-one-symbol
|
|
(let [document (stage/compose source)]
|
|
(is (empty? (clip/problems document)))
|
|
(is (= #{:main :sym/face-8625} (set (keys (:symbols document)))))
|
|
(is (= #{:sym/face-8625} (node/sources (placement document :left))))
|
|
(is (= #{:sym/face-8625} (node/sources (placement document :right))))
|
|
(testing "every placement is keyed by its own uuid"
|
|
;; The identity change: seven placements of one drawing are seven things,
|
|
;; and each is named by something that means only itself. Sharing a key, or
|
|
;; keying by a description of where a thing sits, is what this rules out.
|
|
(let [symbols (filter (comp #{:instance} :kind val)
|
|
(get-in document [:symbols :main :nodes]))]
|
|
(is (= 7 (count symbols)))
|
|
(is (every? uuid? (map key symbols)))
|
|
(is (= 7 (count (distinct (map key symbols)))))
|
|
(testing "and each still says which drawing it plays and what to call it"
|
|
(is (every? #(= #{:sym/face-8625} (node/sources (val %))) symbols))
|
|
(is (every? #(string? (:name (val %))) symbols))
|
|
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
|
|
(is (= 7 (count (filter #(= :instance (:kind %))
|
|
(vals (get-in document [:symbols :main :nodes]))))))
|
|
(is (= [0 232] (:span (placement document :right))) "its own frames, from its own 0")
|
|
(is (= [48 280] (node/placed-span (placement document :right))) "and where that sits on the stage")
|
|
(let [left (placement document :left)
|
|
scale (get-in left [:channels [:xform :scale]])
|
|
anchor (get-in left [:channels [:xform :anchor] :value])
|
|
pos (get-in left [:channels [:xform :pos]])
|
|
start-pos (ch/value-at pos 0 nil)]
|
|
(is (= [160 100] anchor) "the source center becomes a stored pivot")
|
|
(is (= [-120 -60] start-pos))
|
|
(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 nil)))
|
|
(is (= [0.56 0.56] (ch/value-at scale 12 nil)))
|
|
(is (= [0.52 0.52] (ch/value-at scale 48 nil)))
|
|
(doseq [f [0 12 48]]
|
|
(let [m (node/local! (node/mat) start-pos 0 (ch/value-at scale f nil) [0 0] anchor)
|
|
out (js/Float64Array. 2)]
|
|
(node/apply-pt! out 0 m 160 100)
|
|
(is (= [40 40] [(aget out 0) (aget out 1)])
|
|
"the face center stays put while it scales"))))
|
|
(testing "the editorial link resolves to the placement's uuid"
|
|
;; The EDN names `:right`; the document must carry the identity, or the link
|
|
;; dangles the moment anything is renamed. `clip/problems` above checks it
|
|
;; resolves to a node at all; this checks it resolves to the RIGHT one.
|
|
(is (= (uuid-of :right) (:linked-to (placement document :voice-right))))
|
|
(is (uuid? (:linked-to (placement document :voice-right)))))
|
|
(is (= [48 260] (node/placed-span (placement document :voice-right))))
|
|
(is (= 0.5 (ch/value-at
|
|
(get-in (placement document :voice-right)
|
|
[:channels [:audio :gain]]) 54 nil)))
|
|
(is (< -0.8 (ch/value-at
|
|
(get-in (placement document :voice-right)
|
|
[:channels [:audio :pan]]) 110 nil) 0.7))
|
|
(is (= document (leaf/clip "stage" (leaf/leaves "stage" document))))))
|
|
|
|
(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 no-symbol-is-special
|
|
(let [c (nested)]
|
|
(testing "a document opens on the longest symbol nothing places"
|
|
(is (= [:loose :main :outer] (clip/unplaced c)))
|
|
(is (= :outer (clip/opens-on c)))
|
|
(is (= :main (clip/opens-on (clip/blank)))))
|
|
(testing "an instance can go into any symbol, and spans that symbol's frames"
|
|
(let [[n] (vals (get-in c [:symbols :outer :nodes]))]
|
|
(is (= #{:inner} (node/sources n)))
|
|
(is (= [0 10] (:span n)) "its own frames: all of what it places, from its own 0")
|
|
(is (= [5 15] (node/placed-span n)) "and where that lands in the symbol it is in")))
|
|
(testing "placing is refused when it would make a cycle"
|
|
(is (clip/contains-symbol? c :outer :inner))
|
|
(is (not (clip/contains-symbol? c :inner :outer)))
|
|
(is (= c (clip/place-symbol c nil :inner :outer 0 (random-uuid) nil))
|
|
"outer inside inner, which is inside outer")
|
|
(is (= c (clip/place-symbol c nil :inner :inner 0 (random-uuid) nil))
|
|
"a symbol inside itself"))
|
|
(testing "and the result is a valid document whose instance saves"
|
|
(is (empty? (clip/problems c)))
|
|
(is (= (get-in c [:symbols :outer :nodes])
|
|
(get-in (leaf/clip "c" (leaf/leaves "c" c)) [:symbols :outer :nodes]))))))
|
|
|
|
(deftest a-new-symbol-is-empty-and-placed-where-it-was-asked-for
|
|
(let [c (nested)
|
|
u #uuid "00000000-0000-4000-8000-000000000001"
|
|
id (clip/fresh-id c)
|
|
made (clip/new-symbol c :outer id 20 u)]
|
|
(is (= :symbol-1 id))
|
|
(is (= :symbol-2 (clip/fresh-id made)) "the next one does not collide")
|
|
(is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 :nodes {}}
|
|
(clip/symbol made :symbol-1))
|
|
"empty, ordinary, and as long as the rest of what it was placed in")
|
|
(is (= {:span [0 180] :time {:mode :map :at 20 :rate 1}}
|
|
(select-keys (get-in made [:symbols :outer :nodes u]) [:span :time])))
|
|
(is (= #{:symbol-1} (node/sources (get-in made [:symbols :outer :nodes u])))
|
|
"and it places the symbol it just made")
|
|
(is (empty? (clip/problems made)))
|
|
(is (= c (clip/new-symbol c :outer :inner 0 u)) "an id already in use is refused")
|
|
(is (= c (clip/new-symbol c :outer id 200 u)) "past the end is refused")))
|
|
|
|
(deftest an-instance-span-is-in-its-own-frames
|
|
(let [n {:id :i :kind :instance :z "a1" :span [3 13]
|
|
:source {:symbol :x}
|
|
:time {:mode :map :at 40 :rate 2}}]
|
|
(is (= [41.5 46.5] (node/placed-span n)) "own frames 3 to 13, at double rate, from 40")
|
|
(is (= 0 (node/local-frame n 40)) "the parent's :at is where its own frame 0 lands")
|
|
(is (= 8 (node/local-frame n 44)))
|
|
(is (= [2 9] (node/placed-span {:kind :poly :span [2 9]}))
|
|
"a shape has no time of its own, so its span is already the parent's")
|
|
(is (seq (node/problems (assoc-in n [:time :in] 3)))
|
|
"a stale :in is reported rather than silently ignored")))
|
|
|
|
(deftest an-instance-pivots-about-the-middle-of-what-it-draws
|
|
(let [square (fn [x y] {:kind :poly :z "a1" :id :sq
|
|
:channels {[:geom :pts] (ch/framed [x y (+ x 10) y (+ x 10) (+ y 10) x (+ y 10)])
|
|
[:style :color] (ch/framed :brow)}})
|
|
c (-> (clip/blank)
|
|
(assoc-in [:symbols :box] {:id :box :frames 4 :nodes {:sq (assoc (square 20 30) :id :sq)}})
|
|
(assoc-in [:symbols :empty] {:id :empty :frames 4 :nodes {}}))
|
|
u #uuid "00000000-0000-4000-8000-0000000000cc"
|
|
placed (fn [c sid point] (get-in (clip/place-symbol c nil :main sid 0 u point)
|
|
[:symbols :main :nodes u :channels]))]
|
|
(is (= [25 35] (clip/center c nil :box)) "the middle of the square")
|
|
(is (= [160 100] (clip/center c nil :empty)) "nothing drawn: the stage's middle")
|
|
(testing "the anchor is the middle, and it moves nothing at the identity"
|
|
(is (= [25 35] (get-in (placed c :box nil) [[:xform :anchor] :value])))
|
|
(is (= [0 0] (get-in (placed c :box nil) [[:xform :pos] :value]))
|
|
"dropped on the timeline: where it was drawn"))
|
|
(testing "dropped on a stage pixel, its middle goes there"
|
|
(is (= [75 65] (get-in (placed c :box [100 100]) [[:xform :pos] :value]))))
|
|
(testing "and growing the symbol later does not move an instance's pivot"
|
|
(let [c (clip/place-symbol c nil :main :box 0 u nil)
|
|
grown (assoc-in c [:symbols :box :nodes :sq2] (assoc (square 80 30) :id :sq2 :z "a2"))]
|
|
(is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved")
|
|
(is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value]))
|
|
"the instance's did not")))))
|
|
|
|
(deftest palette-context-is-inherited-keyed-and-overridable
|
|
(let [palette (fn [id name a b]
|
|
{:id id :name name :slots [{:hex a} {:hex b}]})
|
|
mark {:id :mark :kind :rect :z "a1"
|
|
:channels {[:geom :size] (ch/framed 2)
|
|
[:style :color] (ch/framed 1)}}
|
|
instance (fn [id child z]
|
|
{:id id :kind :instance :z z :source {:symbol child}})
|
|
document {:fps 30 :width 20 :height 20
|
|
:palettes {:day (palette :day "Day" "#000000" "#112233")
|
|
:flash (palette :flash "Flash" "#ffffff" "#aabbcc")}
|
|
:default-palette :day
|
|
:symbols
|
|
{:main {:id :main :frames 4
|
|
:palette (ch/keyed {0 :day 2 :flash} :hold)
|
|
:nodes {:inherited (instance :inherited :drawing "a1")
|
|
:fixed (assoc (instance :fixed :fixed "a2")
|
|
:palette (ch/framed :day))}}
|
|
:drawing {:id :drawing :frames 4 :nodes {:mark mark}}
|
|
:fixed {:id :fixed :frames 4 :palette (ch/framed :flash)
|
|
:nodes {:mark mark}}}}
|
|
context (pal/compile document)
|
|
resolve (clip/resolver document :main nil context nil)
|
|
colors #(mapv :color (resolve %))]
|
|
(is (= [1 1] (colors 0)) "both children start in the day bank")
|
|
(is (= [3 1] (colors 2))
|
|
"the inheriting child follows the lightning cut; an instance override wins")
|
|
(is (= [17 34 51] (nth (:ramp context) 1)))
|
|
(is (= [170 187 204] (nth (:ramp context) 3)))))
|
|
|
|
(deftest symbol-authoring-palettes-seed-only-the-view-root
|
|
(let [palette (fn [id name color]
|
|
{:id id :name name :slots [{:hex color} {:hex color}]})
|
|
mark {:id :mark :kind :rect :z "a1"
|
|
:channels {[:geom :size] (ch/framed 2)
|
|
[:style :color] (ch/framed 1)}}
|
|
document {:fps 30 :width 20 :height 20
|
|
:palettes {:day (palette :day "Day" "#112233")
|
|
:night (palette :night "Night" "#aabbcc")}
|
|
:default-palette :day
|
|
:symbols
|
|
{:main {:id :main :frames 4 :palette :day :palette-track :palette-lane
|
|
:nodes {:child {:id :child :kind :instance :z "a1"
|
|
:source {:symbol :drawing}}}}
|
|
:palette-lane {:id :palette-lane :name "palette"
|
|
:type :palette-track :display :lane :frames 4
|
|
:nodes {:night {:id :night :kind :instance :z "a1"
|
|
:source {:symbol :night-palette}
|
|
:span [0 1] :time {:at 1}}}}
|
|
:night-palette {:id :night-palette :name "Night"
|
|
:type :palette :palette-ref :night
|
|
:frames 1 :nodes {}}
|
|
:drawing {:id :drawing :frames 4 :palette :night
|
|
:nodes {:mark mark}}}}
|
|
context (pal/compile document)
|
|
main (clip/resolver document :main nil context nil)
|
|
drawing (clip/resolver document :drawing nil context nil)
|
|
color #(-> (%1 %2) first :color)]
|
|
(is (= (pal/render-index context :day 1) (color main 0))
|
|
"a nested symbol's authoring palette does not override the viewed root")
|
|
(is (= (pal/render-index context :night 1) (color main 1))
|
|
"a covered palette-track interval overrides the root fallback")
|
|
(is (= (pal/render-index context :day 1) (color main 2))
|
|
"a nil track interval is a real gap and restores the authoring palette")
|
|
(is (= (pal/render-index context :night 1) (color drawing 0))
|
|
"the same nested symbol uses its authoring palette when viewed directly")
|
|
;; The renderer clears with this exact resolver state before rasterising the
|
|
;; returned ops, so a palette cut changes the stage background as well as
|
|
;; authored shapes.
|
|
(main 1)
|
|
(is (= :night (clip/active-palette main)))
|
|
(is (= (pal/render-index context :night 0)
|
|
(pal/background-index context (clip/active-palette main))))))
|