noe/arthur
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make lanes explicit symbol views

Browse source
This commit is contained in:
Your Name 2026-10-01 19:40:53 -04:00
parent fb38990090
commit e459307a4a
22 changed files with 2183 additions and 2330 deletions
Download patch file Download diff file Expand all files Collapse all files

32
frontend/test/arthur/domain/correction_test.cljs
View file

@ -4,22 +4,22 @@
[arthur.domain.clip :as clip]
[arthur.domain.correction :as correction]
[arthur.domain.leaf :as leaf]
[arthur.domain.lane-test :as fixture]))
[arthur.domain.sequence-test :as fixture]))
(defn- channel [doc id path]
(get-in doc [:symbols :main :nodes id :channels path]))
(deftest authors-the-three-motions-as-ordinary-layer-channels
(let [doc (fixture/document)
constant (correction/add doc :main :girl [:xform :rot]
constant (correction/add doc :main :a [:xform :rot]
{:id :flat :support [2 5] :motion :constant :delta 1})
ramp (correction/add (:clip constant) :main :girl [:xform :rot]
ramp (correction/add (:clip constant) :main :a [:xform :rot]
{:id :ramp :support [6 9] :motion :ramp :start 0 :end 2})
returned (correction/add (:clip ramp) :main :girl [:xform :rot]
returned (correction/add (:clip ramp) :main :a [:xform :rot]
{:id :return :support [9 12] :motion :return
:start 0 :peak 3 :peak-frame 10})
c (channel (:clip returned) :girl [:xform :rot])]
(is (= :girl (:selection returned)))
c (channel (:clip returned) :a [:xform :rot])]
(is (= :a (:selection returned)))
(is (= [:flat :ramp :return] (mapv :id (:over c))))
(is (= [0 0 1 1 1 0 0 1 2 0 3 0]
(mapv #(ch/value-at c % nil) (range 12))))
@ -47,19 +47,19 @@
put3 (ch/layer :put3 [0 2] :replace (ch/framed [1 2 3]))
add3 (ch/layer :add3 [0 2] :offset (ch/framed [1 1 1]))
stacked (assoc base :over [put3 add3])
doc (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos]] stacked)]
(is (:refused (correction/remove-layer doc :main :girl [:xform :pos] :put3))
doc (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos]] stacked)]
(is (:refused (correction/remove-layer doc :main :a [:xform :pos] :put3))
"removing the replacement would expose a wrong-shaped base")
(let [conflicted (assoc-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict]
(let [conflicted (assoc-in doc [:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict]
"old topology")
retried (correction/retry-layer conflicted :main :girl [:xform :pos] :add3)]
retried (correction/retry-layer conflicted :main :a [:xform :pos] :add3)]
(is (:clip retried))
(is (nil? (get-in (:clip retried)
[:symbols :main :nodes :girl :channels [:xform :pos] :over 1 :conflict]))))
[:symbols :main :nodes :a :channels [:xform :pos] :over 1 :conflict]))))
(let [without-replacement (-> doc
(assoc-in [:symbols :main :nodes :girl :channels [:xform :pos] :over]
(assoc-in [:symbols :main :nodes :a :channels [:xform :pos] :over]
[(assoc add3 :conflict "old topology")]))]
(is (:refused (correction/retry-layer without-replacement :main :girl
(is (:refused (correction/retry-layer without-replacement :main :a
[:xform :pos] :add3))
"retry refuses when the current effective base still has the wrong shape"))))
@ -74,13 +74,13 @@
(deftest corrections-round-trip-with-identity-support-and-order
(let [doc (fixture/document)
one (:clip (correction/add doc :main :girl [:xform :rot]
one (:clip (correction/add doc :main :a [:xform :rot]
{:id :one :support [0 3] :motion :constant :delta 1}))
two (:clip (correction/add one :main :girl [:xform :rot]
two (:clip (correction/add one :main :a [:xform :rot]
{:id :two :support [3 6] :motion :ramp
:start 0 :end 2}))
back (leaf/clip "u" (leaf/leaves "u" two))]
(is (= two back))
(is (= [:one :two]
(mapv :id (get-in back [:symbols :main :nodes :girl
(mapv :id (get-in back [:symbols :main :nodes :a
:channels [:xform :rot] :over]))))))

6
frontend/test/arthur/domain/instance_test.cljs
View file

@ -241,11 +241,9 @@
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 {:lane clip/lane-node}}
(is (= {:id :symbol-1 :name "symbol-1" :fps 30 :frames 180 :nodes {}}
(clip/symbol made :symbol-1))
"empty but for the lane every symbol is born with, and as long as the
rest of what it was placed in")
"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])))

650
frontend/test/arthur/domain/lane_test.cljs
View file

@ -1,650 +0,0 @@
(ns arthur.domain.lane-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.bring :as bring]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.lane :as lane]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]))
(defn drawing [id x frames]
{:id id :frames frames
:nodes {:mark {:id :mark :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 4)
[:xform :pos] (ch/framed [x 0])}}}})
(defn cel [id source at duration speed]
{:id id :kind :instance :parent :girl :z (name id)
:source {:symbol source} :playback {:in 0 :speed speed :end :stop}
:time {:at at :rate 1} :span [0 duration]})
(defn document []
(let [a (cel :a :drawing-a 0 4 0)
b (assoc-in (cel :b :drawing-b 4 4 0)
[:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold))
insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)]
{:name "cels" :fps 24 :width 320 :height 200
:symbols
{:main {:id :main :frames 12
:nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"
:channels {[:xform :pos] (ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}}
:a a :b b :insert insert
:plate {:id :plate :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 10)
[:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}}
:drawing-a (drawing :drawing-a 10 1)
:drawing-b (drawing :drawing-b 20 1)
:wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
(ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
(defn sample [doc fs]
(let [r (clip/resolver doc :main nil pal/index-of nil)]
(into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs)))
(deftest one-lane-mixes-held-drawings-and-playing-content
(let [doc (document) at (sample doc (range 12))]
(is (empty? (clip/problems doc)))
(is (= 40 (get-in at [3 [:a :mark]])))
(is (= 60 (get-in at [4 [:b :mark]])))
(is (= 72 (get-in at [5 [:b :mark]])))
(is (= 340 (get-in at [8 [:insert :mark]])))
(is (= 610 (get-in at [11 [:insert :mark]])))
(is (= (zipmap (range 12) (range -40 80 10))
(into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at)))
(is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner")))
(deftest cel-ripple-keeps-lane-keys-and-moves-cel-corrections
(let [doc (document)
result (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})
after (:clip result)
nodes (get-in after [:symbols :main :nodes])]
(is (= :a (:selection result)))
(is (= 14 (get-in after [:symbols :main :frames])))
(is (= [0 6] (node/placed-span (:a nodes))))
(is (= [6 10] (node/placed-span (:b nodes))))
(is (= [10 14] (node/placed-span (:insert nodes))))
(doseq [id [:girl :a :b :insert :plate]]
(is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id))))
(is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id)))))
(let [at (sample after [5 6 7 10])]
(is (= 60 (get-in at [5 [:a :mark]])))
(is (= 80 (get-in at [6 [:b :mark]])))
(is (= 72 (get-in at [7 [:b :mark]])) "B's correction follows B")
(is (= 320 (get-in at [10 [:insert :mark]])) "insert starts on source frame 3"))
(is (empty? (clip/problems after)))
(is (= (assoc-in doc [:symbols :main :frames] 14)
(:clip (lane/extend-hold after :main :a -2 {})))
"shrinking restores content, except the explicitly grown shot")))
(deftest overflow-and-invalid-edits-are-atomic
(let [doc (document)
result (lane/extend-hold doc :main :a 2 {})]
(is (:refused result))
(is (= 14 (:required-frames result)))
(is (not (contains? result :clip)))
(doseq [delta [0 -4 0.5 js/NaN]]
(is (:refused (lane/extend-hold doc :main :a delta {}))))
(is (:refused (lane/extend-hold doc :main :insert 1 {})))
(is (:refused (lane/extend-hold doc :main :missing 1 {})))))
(deftest dragging-a-cel-edge-trims-neighbours-or-ripples-them
(let [doc (document)
plain (:clip (lane/resize-out doc :main :a 6 {}))
across (:clip (lane/resize-out doc :main :a 9 {}))
ripple (:clip (lane/resize-out doc :main :a 6 {:ripple? true
:extent :grow-symbol}))
shrink (:clip (lane/resize-out doc :main :a 2 {:ripple? true}))]
(is (= [[0 6] [6 8] [8 12]]
(mapv node/placed-span (symbol/lane-clips (get-in plain [:symbols :main :nodes]) :girl)))
"a normal grow eats the beginning of the adjacent cel")
(is (= [[0 9] [9 12]]
(mapv node/placed-span (symbol/lane-clips (get-in across [:symbols :main :nodes]) :girl)))
"a long grow removes wholly consumed cels and trims the survivor")
(is (= [[0 6] [6 10] [10 14]]
(mapv node/placed-span (symbol/lane-clips (get-in ripple [:symbols :main :nodes]) :girl)))
"shift-grow moves every later cel")
(is (= [[0 2] [2 6] [6 10]]
(mapv node/placed-span (symbol/lane-clips (get-in shrink [:symbols :main :nodes]) :girl)))
"shift-shrink pulls every later cel left")
(is (:refused (lane/resize-out doc :main :a 0 {})))
(is (:refused (lane/resize-out doc :main :a 2.5 {})))))
(deftest the-middle-of-a-cut-rolls-both-edges
(let [doc (document)
rolled (:clip (lane/roll doc :main :a :b 6))
right-only (:clip (lane/resize-in doc :main :b 6))
grown-left (:clip (lane/resize-in doc :main :b 2))]
(is (= [[0 6] [6 8] [8 12]]
(mapv node/placed-span (symbol/lane-clips (get-in rolled [:symbols :main :nodes]) :girl)))
"the shared cut moves without moving either clip")
(is (= [[0 4] [6 8] [8 12]]
(mapv node/placed-span (symbol/lane-clips (get-in right-only [:symbols :main :nodes]) :girl)))
"the right side of the junction trims only the right clip")
(is (= [[0 2] [2 8] [8 12]]
(mapv node/placed-span (symbol/lane-clips (get-in grown-left [:symbols :main :nodes]) :girl)))
"growing the right clip left trims the neighbour instead of overlapping")
(is (:refused (lane/roll doc :main :a :b 0)))
(is (:refused (lane/roll doc :main :a :insert 6)))))
(deftest a-gap-is-an-uncovered-interval
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
at (sample doc [3 4 7 8])]
(is (= #{:plate} (set (keys (at 4)))))
(is (= #{:plate} (set (keys (at 7)))))
(is (get-in at [8 [:insert :mark]]))
(is (empty? (clip/problems doc)))))
(deftest validation-rejects-overlap-but-allows-empty-lanes
(is (some #(re-find #"overlap" %)
(clip/problems (assoc-in (document) [:symbols :main :nodes :b :time :at] 3))))
(is (empty? (clip/problems
(update-in (document) [:symbols :main :nodes] dissoc :a :b :insert))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf]))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1))))
(is (seq (node/problems {:id :old :kind :instance :z "a"
:channels {[:source] (ch/framed {:of :wave :in 0})}}))
"the obsolete format is rejected"))
(deftest playback-is-independent-of-property-channel-shape
(let [doc (document)
n (get-in doc [:symbols :main :nodes :a])
keyed (node/toggle-key n [:xform :rot] 0 nil)
unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)]
(doseq [n [n keyed unkeyed]]
(is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1))))
(let [n (get-in doc [:symbols :main :nodes :insert])]
(is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10)))
(is (nil? (node/placed-frame n 7 10)))
(is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10))))
(is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10)))))))
(deftest navigation-and-hit-testing-use-the-same-source-time
(let [doc (document)
n (get-in doc [:symbols :main :nodes :insert])]
(is (= 5 (:frame (nest/inside doc nil :main [:insert] 10))))
(is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10))))
(is (= 0 (:frame (nest/inside doc nil :main [:a] 3))))
(is (nil? (:time (nest/inside doc nil :main [:a] 3))))
(is (nil? (nest/inside doc nil :main [:a] 4)))
(is (= ((pick/bounds-of doc nil :main n) 2)
((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0)))))
(deftest seeking-and-source-reuse-do-not-share-cursors
(let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a)
fs [11 0 5 3 8 4 10 1 6 2 9 7]
at (sample doc fs)]
(is (= at (sample doc (reverse fs))))
(is (= at (sample doc (range 12))))
(let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]]
(ch/framed [99 0]))]
(is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]])))
(is (= 139 (get-in (sample edited [0 4]) [4 [:b :mark]]))))))
(deftest cel-identities-and-playback-round-trip
(let [doc (:clip (lane/extend-hold (document) :main :a 2 {:extent :grow-symbol}))
leaves (leaf/leaves :project doc)]
(is (= doc (leaf/clip :project leaves)))
(is (contains? leaves "clip/project/symbol/main/node/a"))
(is (not (contains? leaves "clip/project/symbol/main/channel/girl/source")))
(let [{copied :clip ids :ids}
(bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1))
doc [:main] {})]
(is (= :drawing-a-2 (:drawing-a ids)))
(is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids))))
(is (empty? (clip/problems copied))))))
(deftest one-transaction-undoes-the-ripple-and-shot-extension
(let [doc (document)
after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))
before-leaves (leaf/leaves :p doc)
after-leaves (leaf/leaves :p after)
h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle)
undo (history/undo h after-leaves)
redo (history/redo (:history undo) (:leaves undo))]
(is (= 1 (count (:done h))))
(is (= before-leaves (:leaves undo)))
(is (= after-leaves (:leaves redo)))))
(deftest create-lane-and-append-drawings
(let [doc (:clip (lane/add-lane (clip/blank) :main :girl))
a (:clip (lane/append-drawing doc :main :girl :a :drawing-a {}))
b (:clip (lane/append-drawing a :main :girl :b :drawing-b {}))]
(is (empty? (clip/problems b)))
(is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b]))))
(is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed])))
(is (:refused (lane/append-drawing b :main :girl :a :new {})))))
(deftest arbitrary-symbols-drop-into-the-same-lane-and-claim-their-time
(let [doc (document)
dropped (lane/place-symbol doc nil :main :girl :clip :wave 2
{:extent :grow-symbol :remainder-id :tail})
after (:clip dropped)
clips (symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl)]
(is (= :clip (:selection dropped)))
(is (= [[0 2] [2 12]] (mapv node/placed-span clips))
"the natural ten-frame symbol claims [2,12), trimming/removing incumbents")
(is (= :wave (node/source (second clips))))
(is (= 1 (:speed (node/playback-of (second clips))))
"a dropped symbol plays; it is not converted into a drawing hold")
(is (empty? (clip/problems after)))))
(deftest an-existing-symbol-row-can-be-adopted-by-a-lane
(let [doc (assoc-in (document) [:symbols :main :nodes :badge]
{:id :badge :kind :instance :z "z"
:source {:symbol :wave} :span [0 3]
:time {:at 1 :rate 1}
:playback {:in 2 :speed 1 :end :stop}})
result (lane/adopt doc :main :girl :badge 5
{:extent :grow-symbol :remainder-id :tail})
after (:clip result)
n (get-in after [:symbols :main :nodes :badge])]
(is (= :girl (:parent n)))
(is (= [5 8] (node/placed-span n)))
(is (= {:in 2 :speed 1 :end :stop} (:playback n))
"adoption changes placement, not source timing")
(is (= [[0 4] [4 5] [5 8] [8 12]]
(mapv node/placed-span
(symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl))))
(is (empty? (clip/problems after)))))
(deftest fractional-placement-rates-convert-the-hold-delta
(let [doc (-> (document)
(assoc-in [:symbols :main :nodes :a :time :rate] 2)
(assoc-in [:symbols :main :nodes :a :span] [0 8]))
after (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
(is (= [0 12] (get-in after [:symbols :main :nodes :a :span])))
(is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b]))))))
(deftest bare-shapes-agree-in-reference-and-playback
(let [sym (drawing :bare 12 1)]
(is (= (symbol/eval-frame sym 0 nil pal/index-of nil)
((symbol/resolver sym nil pal/index-of nil) 0))
"omitted style colour must not crash a missing cursor")))
(deftest audio-follows-only-the-playing-cel
(let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"}
:span [0 10]
:channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}}
doc (-> (document)
(assoc-in [:symbols :wave :nodes :voice] voice)
(assoc-in [:symbols :drawing-a :nodes :voice] voice))
[track :as tracks] (nest/audio-tracks doc :main)]
(is (= 1 (count tracks)) "the frozen drawing contributes no audio")
(is (= [8 12] (node/placed-span track)))
(is (= [3 7] (:span track)) "the source in-point trims the audio too")
(is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys])))
(let [moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))
[track] (nest/audio-tracks moved :main)]
(is (= [10 14] (node/placed-span track)))
(is (= [3 7] (:span track))))
(let [fast (-> doc
(assoc-in [:symbols :main :nodes :girl :time] {:at 2 :rate 2})
(assoc-in [:symbols :main :nodes :insert :playback :speed] 2))
[track] (nest/audio-tracks fast :main)]
(is (= [6 7.75] (node/placed-span track)))
(is (= [3 10] (:span track)))
(is (= 4 (get-in track [:time :rate]))))))
(deftest a-looped-insert-schedules-distinct-audio-intervals
(let [doc (-> (document)
(assoc-in [:symbols :wave :frames] 4)
(assoc-in [:symbols :wave :nodes :voice]
{:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]})
(assoc-in [:symbols :main :nodes :insert :playback]
{:in 3 :speed 1 :end :loop}))]
(is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main))))))
(deftest enclosing-retiming-is-respected-when-extending-the-shot
(let [doc (assoc-in (document) [:symbols :main :nodes :girl :time] {:at 8 :rate 2})
result (lane/extend-hold doc :main :a 2 {})]
(is (= 15 (:required-frames result)))
(is (nil? (:clip result)))
(is (= 15 (get-in (lane/extend-hold doc :main :a 2 {:extent :grow-symbol})
[:clip :symbols :main :frames])))))
(deftest reuse-shares-content-and-make-unique-decouples-one-cel
(let [doc (document)
shared (:clip (lane/reuse-drawing doc :main :girl :c :drawing-a
{:extent :grow-symbol}))
edit (fn [c sym x]
(assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]]
(ch/framed [x 0])))]
(is (:refused (lane/reuse-drawing doc :main :girl :c :drawing-a {}))
"the shot has to be extended on purpose")
(is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c]))))
(is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c]))))
(is (empty? (clip/problems shared)))
;; One drawing, two cels: the edit arrives at both.
(let [at (sample (edit shared :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 99 (get-in at [12 [:c :mark]]))))
(let [unique (:clip (lane/make-unique shared :main :c {}))]
(is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c]))))
(is (= (:nodes (get-in shared [:symbols :drawing-a]))
(:nodes (get-in unique [:symbols :drawing-a-2])))
"a copy of the same drawing, not an empty one")
(is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a])))
"the other cel keeps the original")
(let [at (sample (edit unique :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched"))
(let [at (sample (edit unique :drawing-a-2 99) [0 12])]
(is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back"))
(is (empty? (clip/problems unique))))
;; Nothing else places drawing-b, so there is nothing to decouple from.
(is (:refused (lane/make-unique doc :main :b {})))
(is (:refused (lane/make-unique doc :main :girl {}))
"a lane places nothing itself")))
(deftest duplicate-copies-the-drawing-and-not-the-cel
(let [doc (document)
made (:clip (lane/duplicate-drawing doc :main :b :d {:extent :grow-symbol}))
n (get-in made [:symbols :main :nodes :d])]
(is (= :drawing-b-2 (node/source n)))
(is (= (:nodes (get-in doc [:symbols :drawing-b]))
(:nodes (get-in made [:symbols :drawing-b-2]))))
(is (= [12 13] (node/placed-span n)))
(is (= {:in 0 :speed 0 :end :stop} (:playback n)))
(is (nil? (:channels n)) "B's own position correction belongs to B's cel")
(is (= (get-in doc [:symbols :main :nodes :b])
(get-in made [:symbols :main :nodes :b]))
"the drawing duplicated is left as it was")
(is (empty? (clip/problems made)))))
(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them
;; A drawing assembled from another symbol: copying it shallowly must keep
;; using that part, and only an explicit deep copy may promise independence.
(let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part]
{:id :part :kind :instance :z "b" :span [0 1]
:time {:at 0 :rate 1} :source {:symbol :wave}
:playback {:in 0 :speed 0 :end :stop}})
copy (fn [opts] (:clip (lane/duplicate-drawing
doc :main :a :d (merge {:extent :grow-symbol} opts))))
shallow (copy {})
deep (copy {:deep? true})]
(is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part]))))
(is (nil? (get-in shallow [:symbols :wave-2])))
(is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part]))))
(is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2]))))
(is (empty? (clip/problems shallow)))
(is (empty? (clip/problems deep)))))
(deftest reuse-refuses-what-would-not-be-a-document
(let [doc (document)]
(is (:refused (lane/reuse-drawing doc :main :girl :c :nothing-here {})))
(is (:refused (lane/reuse-drawing doc :main :girl :c :main {:extent :grow-symbol}))
"a symbol cannot go inside itself")
(is (:refused (lane/reuse-drawing doc :main :girl :a :drawing-a {:extent :grow-symbol}))
"a cel ID in use is not free")
(is (:refused (lane/reuse-drawing doc :main :plate :c :drawing-a {})))
(is (:refused (lane/duplicate-drawing doc :main :girl :d {})))))
(deftest drawing-on-twos-does-not-quantize-the-lane-transform
;; Cel length IS the drawing cadence, and it is the only thing on twos
;; here: the lane's transform has its own clock and keeps moving every frame.
;; Stepping it would be the cel cadence leaking into continuous motion.
(let [cel (fn [id source at] (cel id source at 2 0))
doc (-> (document)
(update-in [:symbols :main :nodes] dissoc :a :b :insert)
(update-in [:symbols :main :nodes] merge
{:c0 (cel :c0 :drawing-a 0)
:c1 (cel :c1 :drawing-b 2)
:c2 (cel :c2 :drawing-a 4)}))
xs {:c0 10 :c1 20 :c2 10}
at (sample doc (range 6))
showing (fn [f] (first (dissoc (at f) :plate)))]
(is (empty? (clip/problems doc)))
(is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(first (key (showing %))) (range 6)))
"the drawing showing changes every second frame")
(is (= [0 10 20 30 40 50]
(mapv (fn [f] (let [[[id _] cx] (showing f)] (- cx (xs id)))) (range 6)))
"and the lane moves on every frame, odd ones included")))
(defn- drawn
"What every frame draws, as sorted values, so a picture can be compared
without naming the cels that produced it."
[doc fs]
(let [at (sample doc fs)]
(mapv #(sort (vals (get at %))) fs)))
(deftest a-drawing-goes-anywhere-in-the-lane-and-ripples-what-follows
(let [doc (document)
keys-of #(get-in % [:symbols :main :nodes :girl :channels [:xform :pos] :keys])
spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id])))
[:a :n :b :insert])
r (lane/append-drawing doc :main :girl :n :drawing-n
{:at 4 :extent :grow-symbol})]
(is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r))))
(is (= 13 (get-in r [:clip :symbols :main :frames])))
(is (= (keys-of doc) (keys-of (:clip r))) "lane keys stay where they were authored")
(is (= :n (:selection r)))
(is (= 4 (:frame r)))
(is (empty? (clip/problems (:clip r))))
;; The same command with no room refuses, and says how much it needs.
(is (= 13 (:required-frames (lane/append-drawing doc :main :girl :n :drawing-n {:at 4}))))
;; At the very front everything moves.
(is (= [[1 5] [0 1] [5 9] [9 13]]
(spans (:clip (lane/append-drawing doc :main :girl :n :drawing-n
{:at 0 :extent :grow-symbol})))))
;; Inside a cel is not a position for another one.
(is (re-find #"split it first"
(:refused (lane/append-drawing doc :main :girl :n :drawing-n
{:at 2 :extent :grow-symbol}))))
(is (:refused (lane/append-drawing doc :main :girl :n :drawing-n
{:at -1 :extent :grow-symbol})))
(is (:refused (lane/append-drawing doc :main :girl :n :drawing-n
{:at ##Inf :extent :grow-symbol})))
;; Reuse and duplicate take a position too; it is one placement rule.
(is (= [4 5] (node/placed-span
(get-in (lane/reuse-drawing doc :main :girl :n :drawing-b
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))
(is (= [4 5] (node/placed-span
(get-in (lane/duplicate-drawing doc :main :b :n
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))))
(deftest split-then-place-puts-a-drawing-inside-a-hold
;; The two commands the doc asks for, composed: neither one guesses.
(let [doc (document)
cut (:clip (span/split doc :main :a 2 :right))
r (lane/append-drawing cut :main :girl :n :drawing-n
{:at 2 :extent :grow-symbol})
after (:clip r)]
(is (= [[0 2] [2 3] [3 5] [5 9] [9 13]]
(mapv #(node/placed-span (get-in after [:symbols :main :nodes %]))
[:a :n :right :b :insert])))
(is (= (get-in doc [:symbols :main :nodes :girl :channels])
(get-in after [:symbols :main :nodes :girl :channels]))
"the performance is still timed the way it was authored")
(is (empty? (clip/problems after)))))
(deftest a-three-frame-correction-crosses-a-drawing-boundary
;; The lane model's worked example. The correction belongs to the GIRL, so it
;; applies across whichever drawings are showing under it, and outside its
;; three frames the animation evaluates exactly as it did before.
(let [doc (document)
fs (range 12)
before (drawn doc fs)
beat (ch/layer :beat [3 6] :offset (ch/framed [30 0]))
c (update-in doc [:symbols :main :nodes :girl :channels [:xform :pos] :over]
(fnil conj []) beat)
after (drawn c fs)
outside [0 1 2 6 7 8 9 10 11]]
(is (empty? (clip/problems c)))
(is (= (mapv before outside) (mapv after outside))
"outside the support, frame for frame identical")
(let [at (sample c [3 4 5])]
;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one
;; correction, reaching across the cut between them.
(is (= 70 (get-in at [3 [:a :mark]])))
(is (= 90 (get-in at [4 [:b :mark]])))
(is (= 102 (get-in at [5 [:b :mark]])) "and B's own correction still applies under it")
(is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5]))
"while the background, which is not in the lane, does not move"))
;; One document change: one step, and it persists in the channel's own leaf.
(let [b (leaf/leaves :p doc)
a (leaf/leaves :p c)
h (-> nil history/hold (history/record b a 0) history/settle)]
(is (= 1 (count (:done h))))
(is (= b (:leaves (history/undo h a))))
(is (= c (leaf/clip :p a)) "a correction needs no codec of its own"))))
(deftest a-correction-on-one-cel-travels-with-it
;; The other half of ownership: a layer on a cel is in that
;; cel's own frames, so moving the cel moves the correction and
;; nothing has to say so.
(let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0]))
doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over]
(fnil conj []) beat)
moved (:clip (lane/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
;; Stated as the difference from the same document without the correction,
;; so the claim is about WHERE the layer applies and not about arithmetic.
(let [nudge (fn [with without f]
(- (get-in (sample with [f]) [f [:b :mark]])
(get-in (sample without [f]) [f [:b :mark]])))]
(is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7]))
"B's first two frames, which are lane frames 4 and 5")
(is (= [7 7 0 0]
(mapv #(nudge moved (:clip (lane/extend-hold (document) :main :a 2
{:extent :grow-symbol}))
%)
[6 7 8 9]))
"and after A's hold grows, B's first two frames, which are now 6 and 7"))
(is (= (get-in doc [:symbols :main :nodes :b :channels])
(get-in moved [:symbols :main :nodes :b :channels]))
"the layer itself was not touched by the retiming")
(is (empty? (clip/problems moved)))))
(defn- spans [clip ids]
(mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids))
(deftest blanking-leaves-a-gap-and-does-not-close-it
(let [doc (document)
r (lane/blank doc :main :girl [5 7] {:id :rest})
after (:clip r)]
;; B spanned the range, so it became two cels with a hole between them.
(is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert])))
(is (= :rest (:selection r)))
(let [at (sample after [4 5 6 7])]
(is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame")
(is (= #{:plate} (set (keys (at 6)))))
(is (get-in at [4 [:b :mark]]))
(is (get-in at [7 [:rest :mark]])))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing
(let [doc (document)
after (:clip (lane/blank doc :main :girl [4 8] {}))]
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing")
(is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b]))
"a lane does not own its content")
(is (empty? (clip/problems after)))))
(deftest blanking-a-range-trims-what-it-only-partly-covers
(let [doc (document)
after (:clip (lane/blank doc :main :girl [3 9] {}))]
(is (= [[0 3] [9 12]] (spans after [:a :insert])))
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= (get-in (sample doc [9]) [9 [:insert :mark]])
(get-in (sample after [9]) [9 [:insert :mark]]))
"the insert kept its own frames, so frame 9 shows what it showed")
(is (empty? (clip/problems after)))))
(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows
(let [r (lane/overwrite-drawing (document) :main :girl :n :drawing-n 5
{:extent :keep :remainder-id :right})
after (:clip r)
nodes (get-in after [:symbols :main :nodes])]
(is (= :n (:selection r)))
(is (= [[0 4] [4 5] [5 6] [6 8] [8 12]]
(mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert])))
(is (= :drawing-b (node/source (:right nodes))))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blank-refuses-what-it-cannot-do-in-one-piece
(let [doc (document)]
(is (re-find #"free ID" (:refused (lane/blank doc :main :girl [5 7] {})))
"splitting a cel needs an ID for the remainder")
(is (:refused (lane/blank doc :main :girl [5 7] {:id :a})) "and a free one")
(is (:refused (lane/blank doc :main :girl [7 5] {})))
(is (:refused (lane/blank doc :main :girl [5 5] {})))
(is (:refused (lane/blank doc :main :girl [5 6.5] {})))
(is (:refused (lane/blank doc :main :plate [0 2] {})))))
(deftest the-shot-length-is-authored-and-emptying-a-lane-does-not-shorten-it
;; The window and the occupied extent are two facts. A shot with nothing in
;; the last half is a shot somebody authored that long, and deleting the last
;; drawing must not quietly shorten the film.
(let [doc (document)
empty-lane (:clip (lane/blank doc :main :girl [0 12] {}))]
(is (empty? (symbol/lane-clips (get-in empty-lane [:symbols :main :nodes]) :girl)))
(is (= 12 (get-in empty-lane [:symbols :main :frames])))
(is (empty? (clip/problems empty-lane)))
;; Growing is still the caller's word, and only ever grows.
(is (:refused (lane/append-drawing empty-lane :main :girl :n :drawing-n {:at 20})))
(is (= 21 (get-in (lane/append-drawing empty-lane :main :girl :n :drawing-n
{:at 20 :extent :grow-symbol})
[:clip :symbols :main :frames])))
(is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9))
[:symbols :main :frames]))
"and trimming the last cel leaves the window where it was")))
(deftest a-take-placed-in-a-lane-is-still-heard
;; `bring/take` puts a take's sound INSIDE the symbol it makes, so that
;; "wherever the symbol is placed it is heard". A lane is one of the places it
;; can be placed, and must not be the one place that goes silent.
(let [doc (assoc-in (document) [:symbols :take]
{:id :take :frames 10 :fps 24
:nodes {:pic {:id :pic :kind :instance :z "a"
:source {:symbol :wave} :span [0 10]
:time {:mode :map :at 0 :rate 1}
:playback {:in 0 :speed 1 :end :stop}}
:sound {:id :sound :name "sound" :kind :audio
:parent nil :z "z-sound"
:source {:footage "f1"} :span [0 10]
:time {:mode :map :at 0 :rate 1}}}})
at-root (clip/place-symbol doc nil :main :take 0 :root nil)
in-lane (:clip (lane/place-symbol doc nil :main :girl :drop :take 0
{:extent :grow-symbol :remainder-id :tail}))]
(is (= 1 (count (nest/audio-tracks at-root :main)))
"a take placed at the root is heard")
(is (some? in-lane) "the take goes into the lane")
(is (= 1 (count (nest/audio-tracks in-lane :main)))
"and is still heard from inside a lane")))
(deftest a-sound-is-a-clip-in-a-lane-like-any-other
;; Everything in the timeline is a lane, audio included: a sound claims lane
;; time by the same rule, and what a lane will not do is hold both kinds.
(let [made (lane/add-lane (document) :main :track)
seeded (clip/place-sound (:clip made) :main {:sound "s1"} "voice" 6 1 2 :vo)
result (lane/adopt seeded :main :track :vo 2 {:extent :grow-symbol})
after (:clip result)
n (get-in after [:symbols :main :nodes :vo])]
(is (nil? (:refused result)) (str (:refused result)))
(is (= :track (:parent n)))
(is (= [2 8] (node/placed-span n)))
(is (empty? (clip/problems after)))
(is (= 1 (count (nest/audio-tracks after :main)))
"a sound in a lane is still heard")
(is (= [:vo] (mapv :id (symbol/lane-clips (get-in after [:symbols :main :nodes]) :track))))
;; The one thing a lane refuses: being half picture and half sound, which
;; is the explicit capability rather than a guess per frame.
(let [mixed (lane/place-symbol after nil :main :track :also :wave 2
{:extent :grow-symbol :remainder-id :rest})]
(is (:refused mixed))
(is (re-find #"picture or sound" (str (:refused mixed))))
(is (= [:vo] (mapv :id (symbol/lane-clips (get-in after [:symbols :main :nodes]) :track)))
"and the sound it would have had to delete to make room is still there"))))

812
frontend/test/arthur/domain/sequence_test.cljs Normal file
View file

@ -0,0 +1,812 @@
(ns arthur.domain.sequence-test
"The commands that need a SEQUENCE, which is now a symbol drawn as a lane and
its own children rather than a group with `:layout :sequence`. Was
`lane_test`; the fixtures changed and the assertions did not, except where
they are called out below as behaviour that changed on purpose."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.bring :as bring]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]))
(defn drawing [id x frames]
{:id id :frames frames
:nodes {:mark {:id :mark :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 4)
[:xform :pos] (ch/framed [x 0])}}}})
(defn cel
"A clip of the sequence. PARENTLESS, because the symbol is the container."
[id source at duration speed]
{:id id :kind :instance :z (name id)
:source {:symbol source} :playback {:in 0 :speed speed :end :stop}
:time {:at at :rate 1} :span [0 duration]})
(defn document
"`:main`, drawn as a lane, holding three clips and a background shape.
`:plate` HAS NO SPAN, so it is on screen for the whole shot and is not in the
sequence at all — which is what `symbol/children` skips, and the reason an
ordinary shape sitting in a lane symbol is not something an edge edit can trim."
[]
(let [a (cel :a :drawing-a 0 4 0)
b (assoc-in (cel :b :drawing-b 4 4 0)
[:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold))
insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)]
{:name "cels" :fps 24 :width 320 :height 200
:symbols
{:main {:id :main :frames 12 :display :lane
:nodes {:a a :b b :insert insert
:plate {:id :plate :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 10)
[:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}}
:drawing-a (drawing :drawing-a 10 1)
:drawing-b (drawing :drawing-b 20 1)
:wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
(ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
(defn shot
"`doc` with `:main` placed in a containing symbol as the instance `:girl`,
carrying the keyed transform the LANE GROUP used to carry, and the plate moved
out to be the background that is not in the sequence.
THE PLACING INSTANCE IS WHERE THE LANE'S TRANSFORM WENT. A lane was a group
and could be animated; a symbol cannot, so what moves a whole sequence is now
the instance that places it. These are the tests that used to animate `:girl`
the group and now animate `:girl` the instance — the same six keys, and the
same answer frame for frame."
[doc]
(-> doc
(update-in [:symbols :main :nodes] dissoc :plate)
(assoc-in [:symbols :shot]
{:id :shot :frames 12 :fps 24
:nodes {:girl {:id :girl :kind :instance :z "b" :span [0 12]
:time {:mode :map :at 0 :rate 1}
:source {:symbol :main}
:playback {:in 0 :speed 1 :end :stop}
:channels {[:xform :pos]
(ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}}
:plate (get-in doc [:symbols :main :nodes :plate])}})))
(defn sample-in [doc sid fs]
(let [r (clip/resolver doc sid nil pal/index-of nil)]
(into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs)))
(defn sample [doc fs] (sample-in doc :main fs))
(deftest one-sequence-mixes-held-drawings-and-playing-content
(let [doc (document) at (sample doc (range 12))]
(is (empty? (clip/problems doc)))
(is (= 10 (get-in at [3 [:a :mark]])))
(is (= 20 (get-in at [4 [:b :mark]])))
(is (= 22 (get-in at [5 [:b :mark]])))
(is (= 300 (get-in at [8 [:insert :mark]])))
(is (= 600 (get-in at [11 [:insert :mark]])))
(is (= (zipmap (range 12) (range -40 80 10))
(into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at)))
(is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner")))
(deftest the-placing-instance-animates-the-whole-sequence
;; What `:girl` the lane group used to do, `:girl` the instance does: one
;; transform over whichever drawing is showing under it, every frame.
(let [doc (shot (document)) at (sample-in doc :shot (range 12))]
(is (empty? (clip/problems doc)))
(is (= 40 (get-in at [3 [:girl :a :mark]])))
(is (= 60 (get-in at [4 [:girl :b :mark]])))
(is (= 72 (get-in at [5 [:girl :b :mark]])))
(is (= 340 (get-in at [8 [:girl :insert :mark]])))
(is (= 610 (get-in at [11 [:girl :insert :mark]])))
(is (= (zipmap (range 12) (range -40 80 10))
(into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at))
"and the background, which is not in the sequence, does not move with it")))
(deftest cel-ripple-keeps-the-containers-keys-and-moves-cel-corrections
(let [doc (shot (document))
result (span/extend-hold doc :main :a 2 {:extent :grow-symbol})
after (:clip result)
nodes (get-in after [:symbols :main :nodes])]
(is (= :a (:selection result)))
(is (= 14 (get-in after [:symbols :main :frames])))
(is (= [0 6] (node/placed-span (:a nodes))))
(is (= [6 10] (node/placed-span (:b nodes))))
(is (= [10 14] (node/placed-span (:insert nodes))))
(doseq [id [:a :b :insert]]
(is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id))))
(is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id)))))
(is (= (get-in doc [:symbols :shot :nodes :girl])
(get-in after [:symbols :shot :nodes :girl]))
"re-spanning a sequence does not touch what places it")
(let [at (sample-in after :shot [5 6 7 10])]
(is (= 60 (get-in at [5 [:girl :a :mark]])))
(is (= 80 (get-in at [6 [:girl :b :mark]])))
(is (= 72 (get-in at [7 [:girl :b :mark]])) "B's correction follows B")
(is (= 320 (get-in at [10 [:girl :insert :mark]])) "insert starts on source frame 3"))
(is (empty? (clip/problems after)))
(is (= (assoc-in doc [:symbols :main :frames] 14)
(:clip (span/extend-hold after :main :a -2 {})))
"shrinking restores content, except the explicitly grown shot")))
(deftest overflow-and-invalid-edits-are-atomic
(let [doc (document)
result (span/extend-hold doc :main :a 2 {})]
(is (:refused result))
(is (= 14 (:required-frames result)))
(is (not (contains? result :clip)))
(doseq [delta [0 -4 0.5 js/NaN]]
(is (:refused (span/extend-hold doc :main :a delta {}))))
(is (:refused (span/extend-hold doc :main :insert 1 {})))
(is (:refused (span/extend-hold doc :main :missing 1 {})))
(is (:refused (span/extend-hold (update-in doc [:symbols :main] dissoc :display)
:main :a 2 {:extent :grow-symbol}))
"lengthening a hold is a sequence edit, so it needs a symbol drawn as one")))
(deftest dragging-a-cel-edge-trims-neighbours-or-ripples-them
(let [doc (document)
clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes])))
plain (:clip (span/resize-out doc :main :a 6 {}))
across (:clip (span/resize-out doc :main :a 9 {}))
ripple (:clip (span/resize-out doc :main :a 6 {:ripple? true
:extent :grow-symbol}))
shrink (:clip (span/resize-out doc :main :a 2 {:ripple? true}))]
(is (= [[0 6] [6 8] [8 12]] (clips plain))
"a normal grow eats the beginning of the adjacent cel")
(is (= [[0 9] [9 12]] (clips across))
"a long grow removes wholly consumed cels and trims the survivor")
(is (= [[0 6] [6 10] [10 14]] (clips ripple))
"shift-grow moves every later cel")
(is (= [[0 2] [2 6] [6 10]] (clips shrink))
"shift-shrink pulls every later cel left")
(is (:refused (span/resize-out doc :main :a 0 {})))
(is (:refused (span/resize-out doc :main :a 2.5 {})))))
(deftest outside-lane-mode-an-edge-edit-disturbs-nothing
;; The claim-time rule FOLLOWS THE MODE. The same document not drawn as a lane
;; is a composition, and things in a composition are allowed to be on screen
;; together — so growing one clip over another simply does that.
(let [doc (update-in (document) [:symbols :main] dissoc :display)
after (:clip (span/resize-out doc :main :a 6 {}))
nodes (get-in after [:symbols :main :nodes])]
(is (= [0 6] (node/placed-span (:a nodes))))
(is (= [4 8] (node/placed-span (:b nodes))) "the neighbour is left exactly as it was")
(is (= 1 (count (symbol/overlaps (get-in after [:symbols :main])))))
(is (empty? (clip/problems after)) "and an overlap is not a reason a document will not load")))
(deftest the-middle-of-a-cut-rolls-both-edges
(let [doc (document)
clips #(mapv node/placed-span (symbol/children (get-in % [:symbols :main :nodes])))
rolled (:clip (span/roll doc :main :a :b 6))
right-only (:clip (span/resize-in doc :main :b 6))
grown-left (:clip (span/resize-in doc :main :b 2))]
(is (= [[0 6] [6 8] [8 12]] (clips rolled))
"the shared cut moves without moving either clip")
(is (= [[0 4] [6 8] [8 12]] (clips right-only))
"the right side of the junction trims only the right clip")
(is (= [[0 2] [2 8] [8 12]] (clips grown-left))
"growing the right clip left trims the neighbour instead of overlapping")
(is (:refused (span/roll doc :main :a :b 0)))
(is (:refused (span/roll doc :main :a :insert 6)))
(is (:refused (span/roll (update-in doc [:symbols :main] dissoc :display) :main :a :b 6))
"a roll is a sequence edit")))
(deftest a-gap-is-an-uncovered-interval
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
at (sample doc [3 4 7 8])]
(is (= #{:plate} (set (keys (at 4)))))
(is (= #{:plate} (set (keys (at 7)))))
(is (get-in at [8 [:insert :mark]]))
(is (empty? (clip/problems doc)))))
(deftest an-overlap-is-a-bug-report-and-not-a-reason-not-to-load
;; It used to be `clip/problems`, which means the document will not load. A
;; display hint must never be able to do that, so it is its own diagnostic.
(let [clashing (assoc-in (document) [:symbols :main :nodes :b :time :at] 3)]
(is (= [[:a :b]] (symbol/overlaps (get-in clashing [:symbols :main]))))
(is (empty? (clip/problems clashing))
"and the document still loads, to be drawn visibly wrong")
(is (empty? (symbol/overlaps (get-in (document) [:symbols :main]))))
(is (empty? (clip/problems
(update-in (document) [:symbols :main :nodes] dissoc :a :b :insert)))
"an empty sequence is valid — a shot is authored before it is filled")
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf]))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1))))
(is (seq (clip/problems
(assoc-in (document) [:symbols :main :nodes :a :layout] :sequence)))
":layout is not a node field any more")
(is (seq (node/problems {:id :old :kind :instance :z "a"
:channels {[:source] (ch/framed {:of :wave :in 0})}}))
"the obsolete format is rejected")))
(deftest no-command-can-commit-an-overlap
;; THE INVARIANT, ASSERTED OVER THE COMMANDS rather than reasoned about: every
;; one of them commits through `span/finish`, so sampling them is enough.
;; Sampled, in the style of `drawn`, rather than computing expected spans by
;; hand — what is being claimed is that no result holds an overlap, whatever
;; the numbers are.
(let [doc (document)
every-command
(concat
(for [to (range -1 15)] #(span/resize-out % :main :a to {:extent :grow-symbol}))
(for [to (range -1 15)] #(span/resize-out % :main :b to {:ripple? true :extent :grow-symbol}))
(for [to (range -1 15)] #(span/resize-in % :main :b to))
(for [to (range -1 15)] #(span/roll % :main :a :b to))
(for [cut (range -1 15)] #(span/split % :main :insert cut :piece))
(for [to (range -1 15)] #(span/trim % :main :insert :out to))
(for [to (range -1 15)] #(span/move % :main :insert to))
(for [d (range -5 6)] #(span/extend-hold % :main :a d {:extent :grow-symbol}))
(for [a (range 0 13) b (range 0 13)] #(span/blank % :main [a b] {:id :rest}))
(for [at (range -1 15)] #(span/append-drawing % :main :n :drawing-n
{:at at :extent :grow-symbol}))
(for [at (range -1 15)] #(span/reuse-drawing % :main :n :drawing-b
{:at at :extent :grow-symbol}))
(for [at (range -1 15)] #(span/duplicate-drawing % :main :b :n
{:at at :extent :grow-symbol}))
(for [at (range -1 15)] #(span/overwrite-drawing % :main :n :drawing-n at
{:extent :grow-symbol
:remainder-id :rest}))
(for [at (range -1 15)] #(span/place-symbol % nil :main :n :wave at
{:extent :grow-symbol
:remainder-id :rest}))
(for [at (range -1 15)] #(span/adopt % :main :b at {:extent :grow-symbol
:remainder-id :rest}))
[#(span/make-unique (:clip (span/reuse-drawing % :main :n :drawing-a
{:extent :grow-symbol}))
:main :n {})])
results (keep (fn [command] (:clip (command doc))) every-command)]
(is (< 190 (count results)) "the sample is of commands that actually did something")
(doseq [after results]
(is (empty? (symbol/overlaps (get-in after [:symbols :main])))
(str "a command committed an overlap: "
(pr-str (mapv (juxt :id node/placed-span)
(symbol/children (get-in after [:symbols :main :nodes]))))))
(is (empty? (clip/problems after))))))
(deftest turning-lane-mode-on-is-the-one-thing-that-can-be-refused
(let [composed (-> (document)
(update-in [:symbols :main] dissoc :display)
(assoc-in [:symbols :main :nodes :b :time :at] 3))
refused (span/draw-as-lane composed :main true {})
trimmed (:clip (span/draw-as-lane composed :main true {:trim? true}))]
(is (:refused refused))
(is (= 1 (:required-trim refused)))
(is (nil? (:clip refused)) "and nothing moved")
(is (= :lane (get-in trimmed [:symbols :main :display])))
(is (= [[0 3] [3 7] [8 12]]
(mapv node/placed-span (symbol/children (get-in trimmed [:symbols :main :nodes]))))
"the retry trims later-claims-from-earlier, the rule everything else follows")
(is (empty? (symbol/overlaps (get-in trimmed [:symbols :main]))))
(is (empty? (clip/problems trimmed)))
;; A clip the next one wholly covers has nothing left to be.
(let [buried (assoc-in composed [:symbols :main :nodes :b :time :at] 0)
after (:clip (span/draw-as-lane buried :main true {:trim? true}))]
(is (nil? (get-in after [:symbols :main :nodes :a])))
(is (empty? (symbol/overlaps (get-in after [:symbols :main])))))
;; Off is always possible, and changes nothing but the hint.
(let [off (:clip (span/draw-as-lane (document) :main false {}))]
(is (nil? (get-in off [:symbols :main :display])))
(is (= (get-in (document) [:symbols :main :nodes])
(get-in off [:symbols :main :nodes]))))
(is (:refused (span/draw-as-lane (document) :nothing-here true {})))
(is (= :lane (get-in (:clip (span/draw-as-lane (document) :main true {}))
[:symbols :main :display]))
"a sequence that is already one turns on with nothing to trim")))
(deftest playback-is-independent-of-property-channel-shape
(let [doc (document)
n (get-in doc [:symbols :main :nodes :a])
keyed (node/toggle-key n [:xform :rot] 0 nil)
unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)]
(doseq [n [n keyed unkeyed]]
(is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1))))
(let [n (get-in doc [:symbols :main :nodes :insert])]
(is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10)))
(is (nil? (node/placed-frame n 7 10)))
(is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10))))
(is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10)))))))
(deftest navigation-and-hit-testing-use-the-same-source-time
(let [doc (document)
n (get-in doc [:symbols :main :nodes :insert])]
(is (= 5 (:frame (nest/inside doc nil :main [:insert] 10))))
(is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10))))
(is (= 0 (:frame (nest/inside doc nil :main [:a] 3))))
(is (nil? (:time (nest/inside doc nil :main [:a] 3))))
(is (nil? (nest/inside doc nil :main [:a] 4)))
(is (= ((pick/bounds-of doc nil :main n) 2)
((pick/bounds-of doc nil :main (assoc-in n [:playback :in] 5)) 0)))))
(deftest seeking-and-source-reuse-do-not-share-cursors
(let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a)
fs [11 0 5 3 8 4 10 1 6 2 9 7]
at (sample doc fs)]
(is (= at (sample doc (reverse fs))))
(is (= at (sample doc (range 12))))
(let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]]
(ch/framed [99 0]))]
(is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]])))
(is (= 99 (get-in (sample edited [0 4]) [4 [:b :mark]]))))))
(deftest cel-identities-and-playback-round-trip
(let [doc (:clip (span/extend-hold (document) :main :a 2 {:extent :grow-symbol}))
leaves (leaf/leaves :project doc)]
(is (= doc (leaf/clip :project leaves)))
(is (contains? leaves "clip/project/symbol/main/node/a"))
(is (= :lane (get-in (leaf/clip :project leaves) [:symbols :main :display]))
"lane mode is saved like any other field of a symbol")
(let [{copied :clip ids :ids}
(bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1))
doc [:main] {})]
(is (= :drawing-a-2 (:drawing-a ids)))
(is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids))))
(is (empty? (clip/problems copied))))))
(deftest one-transaction-undoes-the-ripple-and-shot-extension
(let [doc (document)
after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))
before-leaves (leaf/leaves :p doc)
after-leaves (leaf/leaves :p after)
h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle)
undo (history/undo h after-leaves)
redo (history/redo (:history undo) (:leaves undo))]
(is (= 1 (count (:done h))))
(is (= before-leaves (:leaves undo)))
(is (= after-leaves (:leaves redo)))))
(deftest a-new-document-is-ordinary-and-a-lane-is-created-explicitly
(let [doc (clip/blank)
lane (:clip (span/draw-as-lane doc :main true {}))
a (:clip (span/append-drawing lane :main :a :drawing-a {}))
b (:clip (span/append-drawing a :main :b :drawing-b {}))]
(is (= {} (get-in doc [:symbols :main :nodes])))
(is (nil? (get-in doc [:symbols :main :display])))
(is (= :lane (get-in lane [:symbols :main :display])))
(is (empty? (clip/problems b)))
(is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b]))))
(is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed])))
(is (:refused (span/append-drawing b :main :a :new {})))))
(deftest arbitrary-symbols-drop-into-the-sequence-and-claim-their-time
(let [doc (document)
dropped (span/place-symbol doc nil :main :clip :wave 2
{:extent :grow-symbol :remainder-id :tail})
after (:clip dropped)
clips (symbol/children (get-in after [:symbols :main :nodes]))]
(is (= :clip (:selection dropped)))
(is (= [[0 2] [2 12]] (mapv node/placed-span clips))
"the natural ten-frame symbol claims [2,12), trimming/removing incumbents")
(is (= :wave (node/source (second clips))))
(is (= 1 (:speed (node/playback-of (second clips))))
"a dropped symbol plays; it is not converted into a drawing hold")
(is (empty? (clip/problems after)))
;; Outside lane mode the same drop claims nothing.
(let [composed (update-in doc [:symbols :main] dissoc :display)
after (:clip (span/place-symbol composed nil :main :clip :wave 2
{:extent :grow-symbol :remainder-id :tail}))]
(is (= [[0 4] [2 12] [4 8] [8 12]]
(mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes]))))
"it is simply placed, on screen with what was already there"))))
(deftest an-existing-clip-can-be-moved-and-claim-where-it-lands
(let [doc (assoc-in (document) [:symbols :main :nodes :badge]
{:id :badge :kind :instance :z "z"
:source {:symbol :wave} :span [0 3]
:time {:at 1 :rate 1}
:playback {:in 2 :speed 1 :end :stop}})
result (span/adopt doc :main :badge 5
{:extent :grow-symbol :remainder-id :tail})
after (:clip result)
n (get-in after [:symbols :main :nodes :badge])]
(is (= [5 8] (node/placed-span n)))
(is (= {:in 2 :speed 1 :end :stop} (:playback n))
"a move changes placement, not source timing")
(is (= [[0 4] [4 5] [5 8] [8 12]]
(mapv node/placed-span (symbol/children (get-in after [:symbols :main :nodes])))))
(is (empty? (clip/problems after)))
(is (:refused (span/adopt doc :main :plate 5 {})) "and a shape has no frames to place")))
(deftest fractional-placement-rates-convert-the-hold-delta
(let [doc (-> (document)
(assoc-in [:symbols :main :nodes :a :time :rate] 2)
(assoc-in [:symbols :main :nodes :a :span] [0 8]))
after (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
(is (= [0 12] (get-in after [:symbols :main :nodes :a :span])))
(is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b]))))))
(deftest bare-shapes-agree-in-reference-and-playback
(let [sym (drawing :bare 12 1)]
(is (= (symbol/eval-frame sym 0 nil pal/index-of nil)
((symbol/resolver sym nil pal/index-of nil) 0))
"omitted style colour must not crash a missing cursor")))
(deftest audio-follows-only-the-playing-cel
(let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"}
:span [0 10]
:channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}}
doc (-> (document)
(assoc-in [:symbols :wave :nodes :voice] voice)
(assoc-in [:symbols :drawing-a :nodes :voice] voice))
[track :as tracks] (nest/audio-tracks doc :main)]
(is (= 1 (count tracks)) "the frozen drawing contributes no audio")
(is (= [8 12] (node/placed-span track)))
(is (= [3 7] (:span track)) "the source in-point trims the audio too")
(is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys])))
(let [moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))
[track] (nest/audio-tracks moved :main)]
(is (= [10 14] (node/placed-span track)))
(is (= [3 7] (:span track))))
;; The retime that used to be the lane group's is the placing instance's.
(let [fast (-> (shot doc)
(assoc-in [:symbols :shot :nodes :girl :time] {:mode :map :at 2 :rate 2})
(assoc-in [:symbols :main :nodes :insert :playback :speed] 2))
[track] (nest/audio-tracks fast :shot)]
(is (= [6 7.75] (node/placed-span track)))
(is (= [3 10] (:span track)))
(is (= 4 (get-in track [:time :rate]))))))
(deftest a-looped-insert-schedules-distinct-audio-intervals
(let [doc (-> (document)
(assoc-in [:symbols :wave :frames] 4)
(assoc-in [:symbols :wave :nodes :voice]
{:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]})
(assoc-in [:symbols :main :nodes :insert :playback]
{:in 3 :speed 1 :end :loop}))]
(is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main))))))
(deftest the-shot-a-sequence-needs-is-in-its-own-frames
;; CHANGED ON PURPOSE. It used to be that an enclosing retime changed how many
;; frames an edit needed, because the lane was INSIDE the symbol being measured
;; and its clock sat between them. The symbol is now the container, so its
;; `:frames` is its own authored window and how fast some instance plays it is
;; not a fact about it.
(let [doc (shot (document))
slow (assoc-in doc [:symbols :shot :nodes :girl :time] {:mode :map :at 8 :rate 2})]
(is (= 14 (:required-frames (span/extend-hold slow :main :a 2 {}))))
(is (= 14 (:required-frames (span/extend-hold doc :main :a 2 {}))))
(is (= 14 (get-in (span/extend-hold slow :main :a 2 {:extent :grow-symbol})
[:clip :symbols :main :frames])))))
(deftest reuse-shares-content-and-make-unique-decouples-one-cel
(let [doc (document)
shared (:clip (span/reuse-drawing doc :main :c :drawing-a {:extent :grow-symbol}))
edit (fn [c sym x]
(assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]]
(ch/framed [x 0])))]
(is (:refused (span/reuse-drawing doc :main :c :drawing-a {}))
"the shot has to be extended on purpose")
(is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c]))))
(is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c]))))
(is (empty? (clip/problems shared)))
;; One drawing, two cels: the edit arrives at both.
(let [at (sample (edit shared :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 99 (get-in at [12 [:c :mark]]))))
(let [unique (:clip (span/make-unique shared :main :c {}))]
(is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c]))))
(is (= (:nodes (get-in shared [:symbols :drawing-a]))
(:nodes (get-in unique [:symbols :drawing-a-2])))
"a copy of the same drawing, not an empty one")
(is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a])))
"the other cel keeps the original")
(let [at (sample (edit unique :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 10 (get-in at [12 [:c :mark]])) "the cel made unique is untouched"))
(let [at (sample (edit unique :drawing-a-2 99) [0 12])]
(is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back"))
(is (empty? (clip/problems unique))))
;; Nothing else places drawing-b, so there is nothing to decouple from.
(is (:refused (span/make-unique doc :main :b {})))
(is (:refused (span/make-unique doc :main :plate {}))
"a shape places nothing itself")))
(deftest duplicate-copies-the-drawing-and-not-the-cel
(let [doc (document)
made (:clip (span/duplicate-drawing doc :main :b :d {:extent :grow-symbol}))
n (get-in made [:symbols :main :nodes :d])]
(is (= :drawing-b-2 (node/source n)))
(is (= (:nodes (get-in doc [:symbols :drawing-b]))
(:nodes (get-in made [:symbols :drawing-b-2]))))
(is (= [12 13] (node/placed-span n)))
(is (= {:in 0 :speed 0 :end :stop} (:playback n)))
(is (nil? (:channels n)) "B's own position correction belongs to B's cel")
(is (= (get-in doc [:symbols :main :nodes :b])
(get-in made [:symbols :main :nodes :b]))
"the drawing duplicated is left as it was")
(is (empty? (clip/problems made)))))
(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them
;; A drawing assembled from another symbol: copying it shallowly must keep
;; using that part, and only an explicit deep copy may promise independence.
(let [doc (assoc-in (document) [:symbols :drawing-a :nodes :part]
{:id :part :kind :instance :z "b" :span [0 1]
:time {:at 0 :rate 1} :source {:symbol :wave}
:playback {:in 0 :speed 0 :end :stop}})
copy (fn [opts] (:clip (span/duplicate-drawing
doc :main :a :d (merge {:extent :grow-symbol} opts))))
shallow (copy {})
deep (copy {:deep? true})]
(is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part]))))
(is (nil? (get-in shallow [:symbols :wave-2])))
(is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part]))))
(is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2]))))
(is (empty? (clip/problems shallow)))
(is (empty? (clip/problems deep)))))
(deftest reuse-refuses-what-would-not-be-a-document
(let [doc (document)]
(is (:refused (span/reuse-drawing doc :main :c :nothing-here {})))
(is (:refused (span/reuse-drawing doc :main :c :main {:extent :grow-symbol}))
"a symbol cannot go inside itself")
(is (:refused (span/reuse-drawing doc :main :a :drawing-a {:extent :grow-symbol}))
"a cel ID in use is not free")
(is (:refused (span/duplicate-drawing doc :main :plate :d {})))))
(deftest drawing-on-twos-does-not-quantize-the-containers-transform
;; Cel length IS the drawing cadence, and it is the only thing on twos here:
;; the instance placing the sequence has its own clock and keeps moving every
;; frame. Stepping it would be the cel cadence leaking into continuous motion.
(let [cel (fn [id source at] (cel id source at 2 0))
doc (-> (shot (document))
(update-in [:symbols :main :nodes] dissoc :a :b :insert)
(update-in [:symbols :main :nodes] merge
{:c0 (cel :c0 :drawing-a 0)
:c1 (cel :c1 :drawing-b 2)
:c2 (cel :c2 :drawing-a 4)}))
xs {:c0 10 :c1 20 :c2 10}
at (sample-in doc :shot (range 6))
showing (fn [f] (first (dissoc (at f) :plate)))]
(is (empty? (clip/problems doc)))
(is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(second (key (showing %))) (range 6)))
"the drawing showing changes every second frame")
(is (= [0 10 20 30 40 50]
(mapv (fn [f] (let [[[_ id _] cx] (showing f)] (- cx (xs id)))) (range 6)))
"and the sequence moves on every frame, odd ones included")))
(defn- drawn
"What every frame draws, as sorted values, so a picture can be compared
without naming the cels that produced it."
[doc sid fs]
(let [at (sample-in doc sid fs)]
(mapv #(sort (vals (get at %))) fs)))
(deftest a-drawing-goes-anywhere-in-the-sequence-and-ripples-what-follows
(let [doc (shot (document))
keys-of #(get-in % [:symbols :shot :nodes :girl :channels [:xform :pos] :keys])
spans #(mapv (fn [id] (node/placed-span (get-in % [:symbols :main :nodes id])))
[:a :n :b :insert])
r (span/append-drawing doc :main :n :drawing-n {:at 4 :extent :grow-symbol})]
(is (= [[0 4] [4 5] [5 9] [9 13]] (spans (:clip r))))
(is (= 13 (get-in r [:clip :symbols :main :frames])))
(is (= (keys-of doc) (keys-of (:clip r)))
"the container's keys stay where they were authored")
(is (= :n (:selection r)))
(is (= 4 (:frame r)))
(is (empty? (clip/problems (:clip r))))
;; The same command with no room refuses, and says how much it needs.
(is (= 13 (:required-frames (span/append-drawing doc :main :n :drawing-n {:at 4}))))
;; At the very front everything moves.
(is (= [[1 5] [0 1] [5 9] [9 13]]
(spans (:clip (span/append-drawing doc :main :n :drawing-n
{:at 0 :extent :grow-symbol})))))
;; Inside a cel is not a position for another one.
(is (re-find #"split it first"
(:refused (span/append-drawing doc :main :n :drawing-n
{:at 2 :extent :grow-symbol}))))
(is (:refused (span/append-drawing doc :main :n :drawing-n
{:at -1 :extent :grow-symbol})))
(is (:refused (span/append-drawing doc :main :n :drawing-n
{:at ##Inf :extent :grow-symbol})))
;; Reuse and duplicate take a position too; it is one placement rule.
(is (= [4 5] (node/placed-span
(get-in (span/reuse-drawing doc :main :n :drawing-b
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))
(is (= [4 5] (node/placed-span
(get-in (span/duplicate-drawing doc :main :b :n
{:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n]))))))
(deftest split-then-place-puts-a-drawing-inside-a-hold
;; The two commands the doc asks for, composed: neither one guesses.
(let [doc (shot (document))
cut (:clip (span/split doc :main :a 2 :right))
r (span/append-drawing cut :main :n :drawing-n {:at 2 :extent :grow-symbol})
after (:clip r)]
(is (= [[0 2] [2 3] [3 5] [5 9] [9 13]]
(mapv #(node/placed-span (get-in after [:symbols :main :nodes %]))
[:a :n :right :b :insert])))
(is (= (get-in doc [:symbols :shot :nodes :girl :channels])
(get-in after [:symbols :shot :nodes :girl :channels]))
"the performance is still timed the way it was authored")
(is (empty? (clip/problems after)))))
(deftest a-three-frame-correction-crosses-a-drawing-boundary
;; The lane model's worked example, with the correction on the INSTANCE that
;; places the sequence: it applies across whichever drawings are showing under
;; it, and outside its three frames the animation evaluates exactly as before.
(let [doc (shot (document))
fs (range 12)
before (drawn doc :shot fs)
beat (ch/layer :beat [3 6] :offset (ch/framed [30 0]))
c (update-in doc [:symbols :shot :nodes :girl :channels [:xform :pos] :over]
(fnil conj []) beat)
after (drawn c :shot fs)
outside [0 1 2 6 7 8 9 10 11]]
(is (empty? (clip/problems c)))
(is (= (mapv before outside) (mapv after outside))
"outside the support, frame for frame identical")
(let [at (sample-in c :shot [3 4 5])]
;; Frame 3 shows drawing A and frames 4 and 5 show drawing B: one
;; correction, reaching across the cut between them.
(is (= 70 (get-in at [3 [:girl :a :mark]])))
(is (= 90 (get-in at [4 [:girl :b :mark]])))
(is (= 102 (get-in at [5 [:girl :b :mark]]))
"and B's own correction still applies under it")
(is (= [-10 0 10] (mapv (fn [f] (js/Math.round (get-in at [f :plate]))) [3 4 5]))
"while the background, which is not in the sequence, does not move"))
;; One document change: one step, and it persists in the channel's own leaf.
(let [b (leaf/leaves :p doc)
a (leaf/leaves :p c)
h (-> nil history/hold (history/record b a 0) history/settle)]
(is (= 1 (count (:done h))))
(is (= b (:leaves (history/undo h a))))
(is (= c (leaf/clip :p a)) "a correction needs no codec of its own"))))
(deftest a-correction-on-one-cel-travels-with-it
;; The other half of ownership: a layer on a cel is in that cel's own frames,
;; so moving the cel moves the correction and nothing has to say so.
(let [beat (ch/layer :beat [0 2] :offset (ch/framed [7 0]))
doc (update-in (document) [:symbols :main :nodes :b :channels [:xform :pos] :over]
(fnil conj []) beat)
moved (:clip (span/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
;; Stated as the difference from the same document without the correction,
;; so the claim is about WHERE the layer applies and not about arithmetic.
(let [nudge (fn [with without f]
(- (get-in (sample with [f]) [f [:b :mark]])
(get-in (sample without [f]) [f [:b :mark]])))]
(is (= [7 7 0 0] (mapv #(nudge doc (document) %) [4 5 6 7]))
"B's first two frames, 4 and 5")
(is (= [7 7 0 0]
(mapv #(nudge moved (:clip (span/extend-hold (document) :main :a 2
{:extent :grow-symbol}))
%)
[6 7 8 9]))
"and after A's hold grows, B's first two frames, which are now 6 and 7"))
(is (= (get-in doc [:symbols :main :nodes :b :channels])
(get-in moved [:symbols :main :nodes :b :channels]))
"the layer itself was not touched by the retiming")
(is (empty? (clip/problems moved)))))
(defn- spans [clip ids]
(mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids))
(deftest blanking-leaves-a-gap-and-does-not-close-it
(let [doc (document)
r (span/blank doc :main [5 7] {:id :rest})
after (:clip r)]
;; B spanned the range, so it became two cels with a hole between them.
(is (= [[0 4] [4 5] [7 8] [8 12]] (spans after [:a :b :rest :insert])))
(is (= :rest (:selection r)))
(let [at (sample after [4 5 6 7])]
(is (= #{:plate} (set (keys (at 5)))) "nothing is drawn on a blanked frame")
(is (= #{:plate} (set (keys (at 6)))))
(is (get-in at [4 [:b :mark]]))
(is (get-in at [7 [:rest :mark]])))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blanking-a-whole-cel-removes-it-and-keeps-its-drawing
(let [doc (document)
r (span/blank doc :main [4 8] {})
after (:clip r)]
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= [[0 4] [8 12]] (spans after [:a :insert])) "and moves nothing")
(is (nil? (:selection r))
"and names nothing, because emptying frames selects nothing sensible")
(is (= (get-in doc [:symbols :drawing-b]) (get-in after [:symbols :drawing-b]))
"a symbol does not own its content")
(is (empty? (clip/problems after)))))
(deftest blanking-a-range-trims-what-it-only-partly-covers
(let [doc (document)
after (:clip (span/blank doc :main [3 9] {}))]
(is (= [[0 3] [9 12]] (spans after [:a :insert])))
(is (nil? (get-in after [:symbols :main :nodes :b])))
(is (= (get-in (sample doc [9]) [9 [:insert :mark]])
(get-in (sample after [9]) [9 [:insert :mark]]))
"the insert kept its own frames, so frame 9 shows what it showed")
(is (empty? (clip/problems after)))))
(deftest overwrite-clears-one-frame-and-does-not-ripple-what-follows
(let [r (span/overwrite-drawing (document) :main :n :drawing-n 5
{:extent :keep :remainder-id :right})
after (:clip r)
nodes (get-in after [:symbols :main :nodes])]
(is (= :n (:selection r)))
(is (= [[0 4] [4 5] [5 6] [6 8] [8 12]]
(mapv #(node/placed-span (get nodes %)) [:a :b :n :right :insert])))
(is (= :drawing-b (node/source (:right nodes))))
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after)))))
(deftest blank-refuses-what-it-cannot-do-in-one-piece
(let [doc (document)]
(is (re-find #"free ID" (:refused (span/blank doc :main [5 7] {})))
"splitting a cel needs an ID for the remainder")
(is (:refused (span/blank doc :main [5 7] {:id :a})) "and a free one")
(is (:refused (span/blank doc :main [7 5] {})))
(is (:refused (span/blank doc :main [5 5] {})))
(is (:refused (span/blank doc :main [5 6.5] {})))
(is (:refused (span/blank (update-in doc [:symbols :main] dissoc :display)
:main [0 2] {}))
"and a composition has no sequence to leave a hole in")))
(deftest the-shot-length-is-authored-and-emptying-it-does-not-shorten-it
;; The window and the occupied extent are two facts. A shot with nothing in
;; the last half is a shot somebody authored that long, and deleting the last
;; drawing must not quietly shorten the film.
(let [doc (document)
emptied (:clip (span/blank doc :main [0 12] {}))]
(is (empty? (symbol/children (get-in emptied [:symbols :main :nodes]))))
(is (= 12 (get-in emptied [:symbols :main :frames])))
(is (empty? (clip/problems emptied)))
;; Growing is still the caller's word, and only ever grows.
(is (:refused (span/append-drawing emptied :main :n :drawing-n {:at 20})))
(is (= 21 (get-in (span/append-drawing emptied :main :n :drawing-n
{:at 20 :extent :grow-symbol})
[:clip :symbols :main :frames])))
(is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9))
[:symbols :main :frames]))
"and trimming the last cel leaves the window where it was")))
(deftest a-take-placed-in-a-sequence-is-still-heard
;; `bring/take` puts a take's sound INSIDE the symbol it makes, so that
;; "wherever the symbol is placed it is heard". A sequence is one of the places
;; it can be placed, and must not be the one place that goes silent.
(let [doc (assoc-in (document) [:symbols :take]
{:id :take :frames 10 :fps 24
:nodes {:pic {:id :pic :kind :instance :z "a"
:source {:symbol :wave} :span [0 10]
:time {:mode :map :at 0 :rate 1}
:playback {:in 0 :speed 1 :end :stop}}
:sound {:id :sound :name "sound" :kind :audio
:parent nil :z "z-sound"
:source {:footage "f1"} :span [0 10]
:time {:mode :map :at 0 :rate 1}}}})
at-root (clip/place-symbol doc nil :main :take 0 :root nil)
placed (:clip (span/place-symbol doc nil :main :drop :take 0
{:extent :grow-symbol :remainder-id :tail}))]
(is (= 1 (count (nest/audio-tracks at-root :main)))
"a take placed at the root is heard")
(is (some? placed) "the take goes into the sequence")
(is (= 1 (count (nest/audio-tracks placed :main)))
"and is still heard from inside one")))
(deftest a-sound-is-a-clip-of-a-sequence-like-any-other
;; A sound claims time by the same rule as a picture, and THERE IS NO MIXTURE
;; RULE ANY MORE: a symbol whose clips are sounds is an audio lane, and that is
;; the whole of it. The refusal that used to say "picture or sound, not both"
;; was a property of a lane node, and there is no lane node.
(let [seeded (clip/place-sound (document) :main {:sound "s1"} "voice" 6 1 2 :vo)
result (span/adopt seeded :main :vo 2 {:extent :grow-symbol})
after (:clip result)
n (get-in after [:symbols :main :nodes :vo])]
(is (nil? (:refused result)) (str (:refused result)))
(is (= [2 8] (node/placed-span n)))
(is (empty? (clip/problems after)))
(is (= 1 (count (nest/audio-tracks after :main)))
"a sound in a sequence is still heard")
(is (contains? (set (map :id (symbol/children (get-in after [:symbols :main :nodes]))))
:vo))
;; Picture over sound is picture claiming the frames, like anything else.
(let [mixed (:clip (span/place-symbol after nil :main :also :wave 2
{:extent :grow-symbol :remainder-id :rest}))]
(is (empty? (symbol/overlaps (get-in mixed [:symbols :main]))))
(is (empty? (clip/problems mixed))))))

266
frontend/test/arthur/domain/span_test.cljs
View file

@ -1,53 +1,22 @@
(ns arthur.domain.span-test
"Split, trim and move, over the two things they have to work on alike: a cel
inside a lane, and a symbol placed straight into a shot. The fixture carries
both on purpose — the commands were lane-gated for as long as a lane was the
only thing anybody had timed, and the point of these tests is that nothing in
them reads a lane."
"Generic span edits in an explicit lane and an ordinary compositing symbol."
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.lane :as lane]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]
[arthur.domain.sequence-test :as fixture]
[arthur.domain.span :as span]))
(defn- drawing [id x frames]
{:id id :frames frames
:nodes {:mark {:id :mark :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 4)
[:xform :pos] (ch/framed [x 0])}}}})
(defn document [] (fixture/document))
(defn- cel [id source at duration speed]
{:id id :kind :instance :parent :girl :z (name id)
:source {:symbol source} :playback {:in 0 :speed speed :end :stop}
:time {:at at :rate 1} :span [0 duration]})
(defn document
"A lane of three cels, and — the part lane_test's fixture has no equivalent of
— `:badge`, an instance of an animated symbol placed straight into `:main`
with a span of its own and no parent at all. Its frames are the SYMBOL's, so
it is the case where the coordinate a command takes is not lane time."
[]
(let [a (cel :a :drawing-a 0 4 0)
b (cel :b :drawing-b 4 4 0)
insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)]
{:name "spans" :fps 24 :width 320 :height 200
:symbols
{:main {:id :main :frames 12
:nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"}
:a a :b b :insert insert
:badge {:id :badge :kind :instance :z "c"
:source {:symbol :wave}
:playback {:in 0 :speed 1 :end :stop}
:time {:at 2 :rate 1} :span [0 8]}
:plate {:id :plate :kind :rect :z "a"
:channels {[:geom :size] (ch/framed 10)
[:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}}
:drawing-a (drawing :drawing-a 10 1)
:drawing-b (drawing :drawing-b 20 1)
:wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
(ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
(defn- ordinary-document []
(-> (document)
(update-in [:symbols :main] dissoc :display)
(assoc-in [:symbols :main :nodes :badge]
{:id :badge :kind :instance :z "z"
:source {:symbol :wave}
:playback {:in 0 :speed 1 :end :stop}
:time {:at 2 :rate 1} :span [0 8]})))
(defn- sample [doc fs]
(let [r (clip/resolver doc :main nil pal/index-of nil)]
@ -57,172 +26,67 @@
(let [at (sample doc fs)]
(mapv #(sort (vals (get at %))) fs)))
(defn- spans [clip ids]
(mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids))
(deftest fixtures-state-the-mode-explicitly
(is (= :lane (get-in (document) [:symbols :main :display])))
(is (nil? (get-in (ordinary-document) [:symbols :main :display])))
(is (empty? (clip/problems (document))))
(is (empty? (clip/problems (ordinary-document)))))
(deftest the-fixture-places-one-thing-outside-the-lane
(deftest splitting-preserves-the-picture-in-both-modes
(doseq [[label doc id cut] [["lane clip" (document) :a 2]
["ordinary placement" (ordinary-document) :badge 6]]]
(testing label
(let [before (drawn doc (range 12))
r (span/split doc :main id cut :right)
after (:clip r)]
(is (= :right (:selection r)))
(is (= before (drawn after (range 12))))
(is (= cut
(second (node/placed-span (get-in after [:symbols :main :nodes id])))
(first (node/placed-span (get-in after [:symbols :main :nodes :right])))))
(is (empty? (clip/problems after)))))))
(deftest split-refuses-an-edge-a-missing-node-and-a-spanless-node
(let [doc (document)]
(is (empty? (clip/problems doc)))
(is (nil? (:parent (get-in doc [:symbols :main :nodes :badge])))
"so a command acting on it has only the symbol's frames to go by")
(is (= [2 10] (node/placed-span (get-in doc [:symbols :main :nodes :badge]))))))
;; ---------------------------------------------------------------------------
;; split
(deftest splitting-changes-nothing-that-is-drawn
(let [doc (document)
fs (range 12)
before (drawn doc fs)]
(doseq [[label id cut] [["a held drawing in a lane" :a 2]
["a playing insert in a lane" :insert 10]
["a placement with no lane at all" :badge 6]]]
(testing label
(let [r (span/split doc :main id cut :right)
after (:clip r)]
(is (= :right (:selection r)))
(is (= before (drawn after fs)) "the same picture, frame for frame")
(is (= (node/placed-span (get-in doc [:symbols :main :nodes id]))
[(first (node/placed-span (get-in after [:symbols :main :nodes id])))
(second (node/placed-span (get-in after [:symbols :main :nodes :right])))])
"the pieces occupy the frames the one node did")
(is (= cut (second (node/placed-span (get-in after [:symbols :main :nodes id])))
(first (node/placed-span (get-in after [:symbols :main :nodes :right])))))
(is (= (:time (get-in doc [:symbols :main :nodes id]))
(:time (get-in after [:symbols :main :nodes :right])))
"one time map, so the right piece's own frames carry on")
(is (= (select-keys (get-in doc [:symbols :main :nodes id])
[:source :playback :channels :parent :z])
(select-keys (get-in after [:symbols :main :nodes :right])
[:source :playback :channels :parent :z]))
"and it keeps its parent and its depth, so it draws where it drew")
(is (= 12 (get-in after [:symbols :main :frames])) "and no shot-length question")
(is (empty? (clip/problems after))))))))
(deftest split-refuses-anything-but-one-cut-inside-one-thing
(let [doc (document)]
(doseq [cut [0 4 8 12 -1 2.5 ##NaN nil]]
(is (:refused (span/split doc :main :b cut :right)) (str "cut at " (pr-str cut))))
(is (:refused (span/split doc :main :a 2 :b)) "the new ID has to be free")
(doseq [cut [0 4 -1 2.5 ##NaN nil]]
(is (:refused (span/split doc :main :a cut :right))))
(is (:refused (span/split doc :main :missing 2 :right)))
(is (re-find #"group" (:refused (span/split doc :main :girl 2 :right)))
"a group is divided by its children, not by its span")
(is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right)))
"and a node with no span has no edges to cut")))
(is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right))))))
;; ---------------------------------------------------------------------------
;; trim
(deftest trimming-only-narrows-the-selected-placement
(doseq [[doc id edge to kept] [[(document) :b :out 6 [4 6]]
[(ordinary-document) :badge :in 5 [5 10]]]]
(let [before (get-in doc [:symbols :main :nodes id])
r (span/trim doc :main id edge to)
after (:clip r)]
(is (= id (:selection r)))
(is (= kept (node/placed-span (get-in after [:symbols :main :nodes id]))))
(is (= (dissoc before :span)
(dissoc (get-in after [:symbols :main :nodes id]) :span)))
(is (empty? (clip/problems after))))))
(deftest trimming-narrows-one-thing-and-moves-nothing-else
(let [doc (document)]
(doseq [[label id edge to kept] [["a cel in a lane" :b :out 6 [4 6]]
["a placement outside one" :badge :out 7 [2 7]]
["the front of one outside a lane" :badge :in 5 [5 10]]]]
(testing label
(let [r (span/trim doc :main id edge to)
after (:clip r)]
(is (= kept (node/placed-span (get-in after [:symbols :main :nodes id]))))
(is (= id (:selection r)))
(is (= (select-keys (get-in doc [:symbols :main :nodes id])
[:time :playback :channels :source])
(select-keys (get-in after [:symbols :main :nodes id])
[:time :playback :channels :source]))
"only :span changed")
(is (= [[0 4] [8 12]] (spans after [:a :insert])) "and no neighbour moved")
(is (= 12 (get-in after [:symbols :main :frames])))
(is (empty? (clip/problems after))))))))
(deftest trimming-the-front-does-not-restart-what-is-playing
;; The difference between trimming and slipping, asserted on the node that has
;; no lane: its own frames are where they were, so the frames that survive
;; show exactly what they showed.
(let [doc (document)
before (sample doc [6 7])
after (:clip (span/trim doc :main :badge :in 6))]
(is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :badge]))))
(is (= (:playback (get-in doc [:symbols :main :nodes :badge]))
(:playback (get-in after [:symbols :main :nodes :badge]))))
(is (= (get-in before [6 [:badge :mark]])
(get-in (sample after [6]) [6 [:badge :mark]]))
"the same animation on the frames it kept")
(is (nil? (get-in (sample after [5]) [5 [:badge :mark]]))
"and the frames it gave up show nothing of it")))
(deftest trim-refuses-to-lengthen-or-to-land-on-an-edge
(let [doc (document)]
(doseq [[label id edge to] [["at its own start" :b :in 4]
["at its own end" :b :out 8]
["past its end" :b :out 9]
["before its start" :b :in 2]
["off a whole frame" :b :out 5.5]
["past the end of one outside a lane" :badge :out 11]
["before the start of one outside a lane" :badge :in 1]]]
(is (:refused (span/trim doc :main id edge to)) label))
(is (:refused (span/trim doc :main :b :middle 6)))
(is (re-find #"group" (:refused (span/trim doc :main :girl :out 6))))))
(deftest timeline-edge-resize-allows-an-ordinary-clip-to-grow
(let [after (:clip (span/resize-out (document) :main :badge 11))]
(deftest resizing-an-ordinary-placement-may-overlap
(let [doc (ordinary-document)
after (:clip (span/resize-out doc :main :badge 11 {}))]
(is (= [2 11] (node/placed-span (get-in after [:symbols :main :nodes :badge]))))
(is (:refused (span/resize-out (document) :main :badge 2)))))
(is (:refused (span/resize-out doc :main :badge 2 {})))))
;; ---------------------------------------------------------------------------
;; move
(deftest moving-follows-the-symbol-mode
(let [lane (document)
ordinary (ordinary-document)]
(is (:refused (span/move lane :main :insert 6)) "a lane clip cannot overlap B")
(let [after (:clip (span/move ordinary :main :badge 0))]
(is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge])))
"an ordinary symbol is free to composite over occupied frames")
(is (empty? (clip/problems after))))))
(deftest moving-keeps-its-length-and-its-source-origin
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
r (span/move doc :main :insert 4)
after (:clip r)]
(is (= [[0 4] [4 8]] (spans after [:a :insert])))
(is (= :insert (:selection r)))
(is (= (:playback (get-in doc [:symbols :main :nodes :insert]))
(:playback (get-in after [:symbols :main :nodes :insert]))))
;; It began on source frame 3 at lane 8; it begins on source frame 3 at lane 4.
(is (= (get-in (sample doc [8]) [8 [:insert :mark]])
(get-in (sample after [4]) [4 [:insert :mark]])))
(deftest clearing-room-then-moving-is-explicit-composition
(let [doc (document)
cleared (:clip (span/blank doc :main [4 8] {}))
after (:clip (span/move cleared :main :insert 4))]
(is (= [4 8] (node/placed-span (get-in after [:symbols :main :nodes :insert]))))
(is (empty? (clip/problems after)))))
(deftest a-move-outside-a-lane-is-free-to-land-on-an-occupied-frame
;; The non-overlap rule is the LANE's, and `:badge` is not in one. Things
;; placed in a composition are allowed to be on screen together, so there is
;; nothing here for a move to refuse.
(let [doc (document)
r (span/move doc :main :badge 0)
after (:clip r)]
(is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge]))))
(is (= [[0 4] [4 8] [8 12]] (spans after [:a :b :insert]))
"and the lane beside it did not notice")
(is (= (get-in (sample doc [2]) [2 [:badge :mark]])
(get-in (sample after [0]) [0 [:badge :mark]]))
"its source origin came with it")
(is (empty? (clip/problems after)))))
(deftest a-move-onto-an-occupied-frame-of-a-lane-is-refused-rather-than-rippled
(let [doc (document)]
(is (:refused (span/move doc :main :insert 6)) "it would overlap B")
(is (:refused (span/move doc :main :insert 4.5)))
(is (re-find #"group" (:refused (span/move doc :main :girl 2))))
(is (re-find #"whole shot" (:refused (span/move doc :main :plate 2))))
;; Clearing the room first is the composition, and then it goes.
(let [cleared (:clip (lane/blank doc :main :girl [4 8] {}))]
(is (= [[0 4] [4 8]] (spans (:clip (span/move cleared :main :insert 4))
[:a :insert]))))))
;; ---------------------------------------------------------------------------
;; the coordinate
(deftest host-frame-reads-lane-time-for-a-cel-and-symbol-time-for-everything-else
(let [doc (document)
retimed (assoc-in doc [:symbols :main :nodes :girl :time] {:at 4 :rate 2})]
(is (= 6 (span/host-frame doc :main :b 6))
"an untimed lane reads the symbol's frames as its own")
(is (= 6 (span/host-frame doc :main :badge 6))
"and so does a node with no parent, always")
(is (= 4 (span/host-frame retimed :main :b 6))
"through a lane at :at 4 :rate 2, symbol frame 6 is lane frame 4")
(is (= 6 (span/host-frame retimed :main :badge 6))
"which is the lane's business and not the badge's")
(is (nil? (span/host-frame (assoc-in doc [:symbols :main :nodes :girl :time]
{:loop? true})
:main :b 6))
"and a looping parent has no single answer to give")))
(deftest host-frame-of-a-parentless-clip-is-the-symbol-frame
(is (= 6 (span/host-frame (document) :main :b 6)))
(is (= 6 (span/host-frame (ordinary-document) :main :badge 6))))

251
frontend/test/arthur/events/lane_test.cljs
View file

@ -1,28 +1,53 @@
(ns arthur.events.lane-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.lane-test :as fixture]
[arthur.domain.clip :as clip]
[arthur.domain.correction :as correction]
[arthur.domain.lane :as lane]
[arthur.events.ui :as ui]
[arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.domain.symbol :as symbol]
[arthur.domain.sequence-test :as fixture]
[arthur.domain.span :as span]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
[arthur.ui.timeline :as timeline]))
[arthur.ui.timeline :as timeline]
[re-frame.core :as rf]
[re-frame.db :as rf-db]))
(deftest one-row-projects-all-cels-and-keeps-selection-addresses
(deftest symbol-and-lane-creation-are-distinct-explicit-commands
(letfn [(run [event key]
(let [doc (clip/blank)
id (store/install! {:clip doc :store {}} key)]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 0}})
(rf/dispatch-sync event)
(let [db @rf-db/app-db
saved (:clip (store/entry id))
[_ _ instance-id] (get-in db [:ui :selection])
sid (get-in saved [:symbols :main :nodes instance-id :source :symbol])]
{:db db :symbol (clip/symbol saved sid)})))]
(let [{ordinary :symbol} (run [::ui/new-symbol :inside] "explicit-symbol")
{lane :symbol lane-db :db} (run [::ui/new-lane] "explicit-lane")]
(is (nil? (:display ordinary)) "new symbol means ordinary symbol")
(is (= :lane (:display lane)) "only the lane command creates a lane")
(is (some? (get-in lane-db [:ui :target]))
"the new lane is aimed so drawing and pool drops can go into it"))))
(deftest an-explicit-lane-is-one-row-of-clips
(let [doc (fixture/document)
rows (timeline/rows doc :main #{})
lane (first (filter :cels rows))]
(is (= 2 (count rows)))
lane (first (filter :lane? rows))]
(is (= 2 (count rows)) "the lane row plus the span-less plate")
(is (= [[0 4] [4 8] [8 12]] (mapv :span (:cels lane))))
(is (= [[:node :main :a [:a]] [:node :main :b [:b]] [:node :main :insert [:insert]]]
(mapv :select (:cels lane))))
(is (= [0 6 12] (:keys lane)))
(is (= 1 (count (filter :cels (timeline/rows doc :main #{[:girl]})))))))
(is (= [[:node :main :a [:a]]
[:node :main :b [:b]]
[:node :main :insert [:insert]]]
(mapv :select (:cels lane))))))
(deftest a-nested-selection-converts-the-open-playhead-to-its-owning-symbol
(deftest an-ordinary-symbol-keeps-a-row-per-node
(let [doc (update-in (fixture/document) [:symbols :main] dissoc :display)
rows (timeline/rows doc :main #{})]
(is (empty? (filter :lane? rows)))
(is (= #{[:a] [:b] [:insert] [:plate]} (set (map :path rows))))))
(deftest a-nested-selection-converts-the-open-playhead-to-its-owner
(let [doc (assoc-in (fixture/document) [:symbols :outer]
{:id :outer :frames 30
:nodes {:take {:id :take :kind :instance :z "a"
@ -34,189 +59,59 @@
(is (= 12 (ui/selection-frame doc nil :main
[:node :main :a [:a]] 12)))))
(deftest polygon-landing-follows-the-target-not-the-selection
(let [doc (fixture/document)
db {:ui {:open :main
:selection [:node :main :plate [:plate]]
:target {:sid :main :id :insert :path [:insert]}}
:playback {:frame 5}}
landing (ui/polygon-landing doc {} db)]
(is (= doc (:clip landing)))
(is (= [:insert] (:path landing))
"looking at another shape does not silently move the creation target")
(is (false? (:lane? landing)))))
(deftest polygon-landing-obeys-the-destination-symbol-mode
(let [lane (fixture/document)
ordinary (update-in lane [:symbols :main] dissoc :display)
db {:ui {:open :main :target {:sid :main :id :plate :path [:plate]}}
:playback {:frame 5}}]
(is (true? (:lane? (ui/polygon-landing lane {} db))))
(is (false? (:lane? (ui/polygon-landing ordinary {} db))))))
(deftest timeline-polygon-landing-is-decided-by-the-aimed-lane
(let [doc (fixture/document)
base {:ui {:open :main
:selection [:node :main :plate [:plate]]
:target {:sid :main :id :girl :path [:girl]}}
:playback {:frame 5}}
occupied (ui/polygon-landing doc {} base)
with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest}))
gap (ui/polygon-landing with-gap {} (assoc-in base [:playback :frame] 6))]
(is (= [:b] (:path occupied))
"the cel on screen wins even while an unrelated stage node is selected")
(is (= doc (:clip occupied)) "an existing cel needs no document edit")
(is (true? (:lane? occupied)))
(is (= 1 (count (:path gap))))
(is (not (contains? (get-in with-gap [:symbols :main :nodes])
(first (:path gap))))
"a gap receives a fresh drawing")
(is (contains? (get-in (:clip gap) [:symbols :main :nodes])
(first (:path gap))))
(is (empty? (clip/problems (:clip gap))))))
(deftest polygon-landing-without-an-aimed-lane-uses-the-ordinary-target
(let [doc (fixture/document)
db {:ui {:open :main
:target {:sid :main :id :plate :path [:plate]}}
:playback {:frame 5}}
landing (ui/polygon-landing doc {} db)]
(is (= doc (:clip landing)))
(is (= [] (:path landing)))
(is (false? (:lane? landing)))))
(deftest beginning-a-polygon-materializes-a-missing-timeline-drawing
(let [doc (fixture/document)
with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest}))
id (store/install! {:clip with-gap :store {}} "polygon-start-test")
db {:clip/current id :paint/revision 0
:ui {:open :main
:target {:sid :main :id :girl :path [:girl]}}
:playback {:frame 6}}
after (ui/beginning-polygon db)
saved (:clip (store/entry (:clip/current after)))
[_ sid cel-id path] (get-in after [:ui :selection])]
(is (= :polygon (get-in after [:ui :tool])))
(is (= [] (get-in after [:ui :draft])))
(is (= :main sid))
(is (= [cel-id] path))
(is (contains? (get-in saved [:symbols :main :nodes]) cel-id)
"the drawing exists before the first draft point is added")
(is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at])))
(is (empty? (clip/problems saved)))))
(deftest beginning-a-polygon-does-not-invent-an-unselected-lane
(deftest beginning-a-polygon-does-not-invent-a-lane
(let [doc (clip/blank)
id (store/install! {:clip doc :store {}} "polygon-lane-start-test")
id (store/install! {:clip doc :store {}} "polygon-no-implicit-lane")
db {:clip/current id :paint/revision 0
:ui {:open :main}
:playback {:frame 6}}
after (ui/beginning-polygon db)
saved (:clip (store/entry (:clip/current after)))
lanes (symbol/lanes (get-in saved [:symbols :main :nodes]))]
saved (:clip (store/entry (:clip/current after)))]
(is (= :polygon (get-in after [:ui :tool])))
(is (= [:lane] (mapv :id lanes))
"the lane the symbol was born with, and no second one invented here")
(is (empty? (symbol/lane-clips (get-in saved [:symbols :main :nodes]) :lane))
"and nothing put in it")
(is (nil? (get-in after [:ui :target])))
(is (nil? (get-in (store/entry (:clip/current after)) [:history :done])))
(is (empty? (clip/problems saved)))))
(is (= {} (get-in saved [:symbols :main :nodes])))
(is (nil? (get-in saved [:symbols :main :display])))
(is (nil? (get-in (store/entry (:clip/current after)) [:history :done])))))
(deftest sequence-commands-use-isolated-history-transactions
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "sequence-test")
id (store/install! {:clip doc :store {}} "sequence-command-test")
db {:clip/current id :paint/revision 0
:ui {:open :main :selection [:node :main :a [:a]]}}
refused (ui/apply-lane-command db :main
(lane/extend-hold doc :main :a 1 {}) [:retry])]
refused (ui/apply-command db :main
(span/extend-hold doc :main :a 1 {}) [:retry])]
(is (= doc (:clip (store/entry id))))
(is (nil? (:history (store/entry id))))
(is (= [:retry] (get-in refused [:ui :lane-retry])))
(let [r1 (lane/extend-hold doc :main :a 1 {:extent :grow-symbol})
db1 (ui/apply-lane-command db :main r1 nil)
r2 (lane/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol})
db2 (ui/apply-lane-command db1 :main r2 nil)
(is (= [:retry] (get-in refused [:ui :retry])))
(let [r1 (span/extend-hold doc :main :a 1 {:extent :grow-symbol})
db1 (ui/apply-command db :main r1 nil)
r2 (span/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol})
db2 (ui/apply-command db1 :main r2 nil)
h (:history (store/entry id))
undo (history/undo h (leaf/leaves "u" (:clip r2)))
undo2 (history/undo (:history undo) (:leaves undo))]
(is (= 2 (count (:done h))) "rapid button presses remain separate commands")
(is (= 2 (count (:done h))))
(is (= (:clip r1) (leaf/clip "u" (:leaves undo))))
(is (= doc (leaf/clip "u" (:leaves undo2))))
(is (= [:node :main :a [:a]] (get-in db2 [:ui :selection]))))))
(deftest a-correction-is-one-step-and-keeps-the-full-selection-address
(deftest an-expanded-lane-opens-the-selected-clip
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "correction-event-test")
selection [:node :main :a [:outer :a]]
db {:clip/current id :paint/revision 0
:ui {:open :outer :selection selection}}
result (correction/add doc :main :a [:xform :rot]
{:id :nudge :support [0 3] :motion :return
:start 0 :peak 0.5 :peak-frame 1})
after (ui/apply-correction-command db result)
entry (store/entry id)]
(is (= selection (get-in after [:ui :selection])))
(is (= 1 (count (get-in entry [:history :done]))))
(is (= 0.5 (get-in (:clip entry)
[:symbols :main :nodes :a :channels [:xform :rot]
:over 0 :values :keys 1])))
(let [refused (ui/apply-correction-command after {:refused "nope"})]
(is (= "nope" (get-in refused [:project :status])))
(is (= 1 (count (get-in (store/entry id) [:history :done])))))))
rows (timeline/rows doc :main #{[:arthur.ui.timeline/lane] [:insert]} [:insert])
portal (first (filter :portal? rows))]
(is (= [:insert] (:path portal)))
(is (= [:node :main :insert [:insert]] (:select portal)))
(is (some #{"mark"} (map :label rows)))))
(deftest an-expanded-lane-opens-the-selected-clip-and-everything-under-it
;; The whole document is editable from the root timeline: a lane opens one
;; portal — the clip selected in it — and that portal opens the lanes and
;; nodes of the symbol it places, mapped into this ruler.
(let [doc (fixture/document)
open #{[:girl] [:insert]}
shut (timeline/rows doc :main open [:insert])
of (fn [rows] (mapv (juxt :label :depth) rows))
lane-row (first (filter :cels (timeline/rows doc :main open [:insert])))]
(is (= 1 (count (filter :portal? shut)))
"exactly one clip is opened, not one branch per clip in the lane")
(is (= [:insert] (:path (first (filter :portal? shut))))
"and it is the selected one")
(is (some #{["mark" 2]} (of shut))
"the clip's own symbol appears under it, at its depth")
(is (= [:node :main :insert [:insert]]
(:select (first (filter :portal? shut))))
"the portal addresses the same clip its block in the lane does")
(is (= (:keys (second (:cels lane-row)))
(:keys (first (filter #(= [:b] (:path %)) (timeline/rows doc :main open [:b])))))
"a clip's keys are on its block whether or not its portal is open")))
(deftest a-nested-selection-keeps-the-portal-that-revealed-it-open
;; Clicking a shape inside the clip — or the end of its span — is still
;; working inside that clip. Matching the selected id alone would close the
;; portal the moment anything under it was touched.
(let [doc (fixture/document)
open #{[:girl] [:insert]}
deep (timeline/rows doc :main open [:insert :mark])
none (timeline/rows doc :main open [:plate])]
(is (= [:insert] (:path (first (filter :portal? deep))))
"a selection under the clip keeps that clip's portal")
(is (empty? (filter :portal? none)))
(is (some #{"select a clip to inspect"} (map :label none))
"with nothing selected in it, an open lane says what it is waiting for")))
(deftest a-held-clip-shows-its-contents-without-inventing-frames-for-them
;; `clip/source-time` is nil for a hold, so nested keys have no place on this
;; ruler — but the drawing's own nodes must still be reachable from here.
(let [doc (fixture/document)
rows (timeline/rows doc :main #{[:girl] [:a]} [:a])
inside (filter :unmapped? rows)]
(is (seq inside) "a held drawing opens")
(is (some #{"mark"} (map :label inside)))
(is (every? (comp empty? :keys) inside)
"no key is placed where the hold cannot say it belongs")
(is (= [[0 4]] (distinct (keep :span (filter #(= :node (:kind %)) inside))))
"its rows span the hold, which is when it is on screen")))
(deftest a-lane-of-sounds-is-drawn-as-a-lane-and-not-flattened-twice
(let [made (lane/add-lane (fixture/document) :main :track)
seeded (clip/place-sound (:clip made) :main {:sound "s1"} "voice" 6 1 2 :vo)
doc (:clip (lane/adopt seeded :main :track :vo 2 {:extent :grow-symbol}))
picture (remove :sound? (timeline/rows doc :main #{} nil))
sound-lanes (filter :sound? (timeline/rows doc :main #{} nil))
flattened (timeline/sound-rows doc :main #{})]
(is (= 1 (count sound-lanes)) "the sound's lane is one row, like any lane")
(is (= [:vo] (mapv :id (:cels (first sound-lanes))))
"with the sound on it as a block that can be moved and trimmed")
(is (empty? (filter #(= [:track] (:path %)) picture))
"and it is not also listed among the picture rows")
(is (empty? flattened)
"nor flattened into a second, parallel audio row")))
(deftest a-lane-of-sounds-is-not-flattened-twice
(let [base (:clip (span/draw-as-lane (clip/blank) :main true {}))
doc (clip/place-sound base :main {:sound "s1"} "voice" 6 1 2 :vo)
lane (first (filter :lane? (timeline/rows doc :main #{} nil)))]
(is (= [:vo] (mapv :id (:cels lane))))
(is (empty? (timeline/sound-rows doc :main #{})))))

444
frontend/test/browser/lane.mjs
View file

@ -1,5 +1,5 @@
// Local editor smoke test. Uses the in-memory blank document and disables the
// project route, so it never creates an account, project, or server-side write.
// Browser smoke test for the explicit-lane workflow. It uses the in-memory
// document and disables project routing, so it performs no server-side write.
import { spawn } from 'node:child_process';
import { mkdtempSync, rmSync } from 'node:fs';
import { tmpdir } from 'node:os';
@ -7,7 +7,7 @@ import { join } from 'node:path';
import assert from 'node:assert/strict';
const url = process.env.ARTHUR_URL ?? 'http://localhost:8778/';
const profile = mkdtempSync(join(tmpdir(), 'arthur-sequence-'));
const profile = mkdtempSync(join(tmpdir(), 'arthur-explicit-lane-'));
const port = 9335;
const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
'--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run',
@ -16,6 +16,7 @@ const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
], { stdio: 'ignore' });
const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));
let ws;
try {
let target;
for (let i = 0; i < 100 && !target; i++) {
@ -23,11 +24,12 @@ try {
try {
target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json()))
.find(t => t.type === 'page' && t.url.startsWith(url));
} catch { /* browser starting */ }
} catch { /* Chromium is still starting. */ }
}
assert(target, 'browser exposes the editor page');
ws = new WebSocket(target.webSocketDebuggerUrl);
await new Promise((resolve, reject) => { ws.onopen = resolve; ws.onerror = reject; });
let serial = 0;
const pending = new Map();
const errors = [];
@ -35,10 +37,10 @@ try {
const msg = JSON.parse(data);
if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails);
if (msg.id && pending.has(msg.id)) {
const { resolve, reject } = pending.get(msg.id);
const waiting = pending.get(msg.id);
pending.delete(msg.id);
if (msg.error) reject(new Error(JSON.stringify(msg.error)));
else resolve(msg.result);
if (msg.error) waiting.reject(new Error(JSON.stringify(msg.error)));
else waiting.resolve(msg.result);
}
};
const send = (method, params = {}) => new Promise((resolve, reject) => {
@ -47,13 +49,16 @@ try {
ws.send(JSON.stringify({ id, method, params }));
});
const evaluate = async expression => {
const r = await send('Runtime.evaluate', { expression, returnByValue: true, awaitPromise: true });
if (r.exceptionDetails) throw new Error(JSON.stringify(r.exceptionDetails));
return r.result.value;
const result = await send('Runtime.evaluate', {
expression, returnByValue: true, awaitPromise: true,
});
if (result.exceptionDetails) throw new Error(JSON.stringify(result.exceptionDetails));
return result.result.value;
};
await send('Runtime.enable');
for (let i = 0; i < 100; i++) {
if (await evaluate('typeof arthur !== "undefined" && !!arthur.events?.ui && !!document.querySelector("canvas.stage")')) break;
if (await evaluate('typeof arthur !== "undefined" && !!document.querySelector("canvas.stage")')) break;
await sleep(100);
}
await evaluate(`(() => {
@ -61,342 +66,145 @@ try {
cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test')));
window.laneSnapshot = () => {
const db = cljs.core.deref(re_frame.db.app_db);
const entry = arthur.footage.store.entry(cljs.core.get(db, k('clip/current')));
return cljs.core.clj__GT_js(entry);
return cljs.core.clj__GT_js(arthur.footage.store.entry(cljs.core.get(db, k('clip/current'))));
};
return true;
})()`);
await sleep(250);
// A command is named the same wherever it is drawn, and since the transport
// strip was consolidated it is drawn in one of two places: as a button in the
// strip, or as a row in one of the strip's menus. So the test asks for it by
// name and this finds it — opening each menu in turn to look — rather than the
// test knowing which menu anything ended up in. An icon button is matched on
// its `aria-label`, which is also what a screen reader is told it is.
// Two bars carry commands: the location bar says where an edit lands and holds
// what creates things there, the transport strip holds what acts on a cel.
const bars = ['.loc', '.pane.time .pane-head', '.section'];
const within = (suffix) => bars.map((b) => `${b} ${suffix}`).join(', ');
const named = label =>
`(b => b.textContent.trim() === ${JSON.stringify(label)}` +
` || b.getAttribute('aria-label') === ${JSON.stringify(label)})`;
const shut = async () => {
await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(s => s.click()); return true })()`);
await sleep(120);
const named = label => `(b => b.getAttribute('aria-label') === ${JSON.stringify(label)}` +
` || b.textContent.trim() === ${JSON.stringify(label)})`;
const closeMenus = async () => {
await evaluate(`(() => { document.querySelectorAll('.menu-scrim').forEach(x => x.click()); return true })()`);
await sleep(80);
};
// Leaves the control on screen and returns what to select it with.
const reveal = async label => {
await shut();
if (await evaluate(`![...document.querySelectorAll('${within('button')}')].find(${named(label)})`)) {
const menus = await evaluate(
`[...document.querySelectorAll('${within('.menu-wrap > button')}')].map(b => b.textContent.trim())`);
let found = false;
for (const menu of menus) {
await evaluate(`(() => { [...document.querySelectorAll('${within('.menu-wrap > button')}')]
.find(b => b.textContent.trim() === ${JSON.stringify(menu)}).click(); return true })()`);
await sleep(180);
if (await evaluate(`!![...document.querySelectorAll('.menu-item')].find(${named(label)})`)) { found = true; break; }
await shut();
}
assert(found, `a control named: ${label}`);
return '.menu-item';
}
return within('button');
};
const click = async label => {
const where = await reveal(label);
const clickNew = async label => {
await closeMenus();
assert(await evaluate(`(() => {
const b = [...document.querySelectorAll('${where}')].find(${named(label)});
if (!b || b.disabled) return false;
b.click(); return true;
})()`), `enabled control: ${label}`);
await sleep(180);
await shut();
const menu = document.querySelector('.loc .menu-wrap > button');
if (!menu) return false;
menu.click(); return true;
})()`), 'new menu exists');
await sleep(100);
assert(await evaluate(`(() => {
const item = [...document.querySelectorAll('.menu-item')].find(${named(label)});
if (!item || item.disabled) return false;
item.click(); return true;
})()`), `enabled creation command: ${label}`);
await sleep(220);
await closeMenus();
};
// UUIDs expose a mutable hash cache through clj->js; compare their identity,
// not that implementation detail, when asserting exact undo restoration.
const shot = async () => JSON.parse(JSON.stringify(await evaluate('laneSnapshot()'),
(_key, value) => value?.uuid ?? value));
const instances = s => Object.values(s.clip.symbols.main.nodes)
.filter(n => n.kind === 'instance')
.sort((a, b) => a.time.at - b.time.at);
const placed = s => instances(s).map(n => [
n.time.at + n.span[0] / (n.time.rate ?? 1),
n.time.at + n.span[1] / (n.time.rate ?? 1),
]);
const key = async (key, extra = {}) => {
await send('Input.dispatchKeyEvent', {type: 'keyDown', key, ...extra});
await send('Input.dispatchKeyEvent', {type: 'keyUp', key, ...extra});
await sleep(180);
};
const undo = () => key('z', {modifiers: 2});
const drag = async (selector, df, {zone = 0.5, shift = false} = {}) => {
const points = await evaluate(`(() => {
const handle = document.querySelector(${JSON.stringify(selector)});
if (!handle) return null;
const track = handle.closest('.tl-track');
const h = handle.getBoundingClientRect();
const t = track.getBoundingClientRect();
const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]);
const x = h.left + h.width * ${zone};
const y = h.top + h.height / 2;
return {x, y, end: x + t.width * ${df} / frames};
})()`);
assert(points, `drag handle exists: ${selector}`);
const modifiers = shift ? 8 : 0;
await send('Input.dispatchMouseEvent', {
type: 'mousePressed', x: points.x, y: points.y,
button: 'left', buttons: 1, clickCount: 1, modifiers,
});
await sleep(100);
await send('Input.dispatchMouseEvent', {
type: 'mouseMoved', x: points.end, y: points.y,
button: 'left', buttons: 1, modifiers,
});
await sleep(100);
await send('Input.dispatchMouseEvent', {
type: 'mouseReleased', x: points.end, y: points.y,
button: 'left', buttons: 0, clickCount: 1, modifiers,
});
await sleep(250);
};
const tabs = () => evaluate(`(() => {
const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db);
return {tabs: cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('tabs')])).map(String),
open: String(cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('open')])))};
})()`);
// A real two-press double-click, not `.dispatchEvent`: what broke here was
// where the browser decides to deliver the click, which a synthetic event
// cannot show.
const doubleClick = async selector => {
const p = await evaluate(`(() => {
const el = document.querySelector(${JSON.stringify(selector)});
if (!el) return null;
const r = el.getBoundingClientRect();
return {x: r.left + r.width / 2, y: r.top + r.height / 2};
})()`);
assert(p, `something to double-click: ${selector}`);
for (const clickCount of [1, 2]) {
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: p.x, y: p.y,
button: 'left', buttons: 1, clickCount});
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: p.x, y: p.y,
button: 'left', buttons: 0, clickCount});
await sleep(60);
}
await sleep(280);
};
const dropPoolSymbol = async frame => {
const points = await evaluate(`(() => {
const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]');
const track = document.querySelector('.tl-track');
if (!source || !track) return null;
source.scrollIntoView({block: 'center'});
const a = source.getBoundingClientRect(), b = track.getBoundingClientRect();
const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]);
return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * (${frame} + 0.25) / frames,
ty: b.top + b.height / 2};
})()`);
assert(points, 'a library symbol and lane are available to drag');
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx, y: points.sy});
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy,
button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx + 12, y: points.sy,
button: 'left', buttons: 1});
await sleep(120);
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty,
button: 'left', buttons: 1});
await sleep(120);
assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0,
'targeting an existing lane does not preview a temporary new row');
const lanePreview = await evaluate(`(() => {
const db = cljs.core.deref(re_frame.db.app_db), k = cljs.core.keyword;
return {ghosts: document.querySelectorAll('.tl-track .tl-cel.ghost').length,
drop: cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('drop')]))};
})()`);
assert.equal(lanePreview.ghosts, 1,
`the pool drop preview is drawn inside the targeted lane: ${JSON.stringify(lanePreview)}`);
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty,
button: 'left', buttons: 0, clickCount: 1});
await sleep(300);
};
const dragClipBetweenLanes = async frame => {
const points = await evaluate(`(() => {
const tracks = [...document.querySelectorAll('.tl-track')];
const source = tracks[1]?.querySelector('.tl-cel');
const target = tracks[0];
if (!source || !target) return null;
const a = source.getBoundingClientRect(), b = target.getBoundingClientRect();
const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]);
return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * (${frame} + 0.25) / frames,
ty: b.top + b.height / 2};
})()`);
assert(points, 'two lanes and a source clip are available');
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy,
button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty,
button: 'left', buttons: 1});
await sleep(150);
assert.equal(await evaluate('document.querySelectorAll(".tl-track")[0].querySelectorAll(".tl-cel.ghost").length'), 1,
'cross-lane movement previews in the destination lane');
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty,
button: 'left', buttons: 0, clickCount: 1});
await sleep(300);
};
const mainInstances = s => Object.values(s.clip.symbols.main.nodes)
.filter(n => n.kind === 'instance');
const laneSymbols = s => Object.values(s.clip.symbols).filter(sym => sym.display === 'lane');
assert.equal(await evaluate('[...document.querySelectorAll(".timing-controls > button")].every(b => b.disabled)'), true,
'timing buttons are disabled without a symbol clip');
await click('inside');
assert.equal((await shot()).clip.symbols.main.display, undefined,
'a blank document starts as an ordinary symbol');
await clickNew('inside');
let s = await shot();
assert.deepEqual(placed(s), [[0, 1]],
'new at the root automatically makes a lane and a one-frame symbol clip');
assert.equal(await evaluate('document.querySelectorAll(".tl-label .kind").length'), 1,
'new temporal content creates a lane row rather than a row per symbol');
assert.equal(await evaluate(`document.querySelectorAll('.cel-sheet, [aria-label="time view"]').length`), 0,
'there is one temporal interface');
assert.equal(await evaluate('document.querySelectorAll(".timing-controls > button").length'), 3,
'timing operations are direct buttons');
let placed = mainInstances(s);
assert.equal(placed.length, 1, 'new symbol places one instance');
assert.equal(s.clip.symbols[placed[0].source.symbol].display, undefined,
'new symbol remains ordinary');
assert.equal(await evaluate('document.querySelectorAll(".tl-track").length'), 1,
'an ordinary symbol is an ordinary timeline row');
await drag('.tl-cel .tl-edge.out', 3);
await clickNew('lane');
s = await shot();
assert.deepEqual(placed(s), [[0, 4]], 'a right edge directly changes the endpoint');
placed = mainInstances(s);
assert.equal(placed.length, 2, 'explicit lane places a second symbol');
assert.equal(laneSymbols(s).length, 1, 'only the lane command marks a symbol as a lane');
assert.equal(await evaluate('[...document.querySelectorAll(".tl-track")].filter(t => t.arthurLane).length'), 1,
'the explicit lane is drawn as one linear track');
for (let i = 0; i < 4; i++) await click('+1');
await click('inside');
await drag('.tl-cel:nth-of-type(2) .tl-edge.out', 2);
for (let i = 0; i < 3; i++) await click('+1');
await click('inside');
s = await shot();
assert.deepEqual(placed(s), [[0, 4], [4, 7], [7, 8]]);
await drag('.tl-cel:nth-of-type(2) .tl-junction', 1, {zone: 0.5});
assert.deepEqual(placed(await shot()), [[0, 5], [5, 7], [7, 8]],
'the middle of a junction rolls both edges');
await undo();
await drag('.tl-cel:nth-of-type(2) .tl-junction', 1, {zone: 0.9});
assert.deepEqual(placed(await shot()), [[0, 4], [5, 7], [7, 8]],
'the right side trims only the right clip');
await undo();
await drag('.tl-cel:nth-of-type(2) .tl-junction', -1, {zone: 0.1});
assert.deepEqual(placed(await shot()), [[0, 3], [4, 7], [7, 8]],
'the left side trims only the left clip');
await undo();
await drag('.tl-cel:nth-of-type(2) .tl-edge.out', 2, {shift: true});
assert.deepEqual(placed(await shot()), [[0, 4], [4, 9], [9, 10]],
'Shift-edge ripples every later clip on the lane');
await undo();
await drag('.tl-cel:first-of-type .tl-edge.out', 2);
assert.deepEqual(placed(await shot()), [[0, 6], [6, 7], [7, 8]],
'ordinary growth trims adjacent spans and never overlaps');
await dropPoolSymbol(10);
s = await shot();
assert.deepEqual(placed(s), [[0, 6], [6, 7], [7, 8], [10, 11]],
'an arbitrary library symbol drops into an existing lane');
assert.equal(instances(s).at(-1).playback.speed, 1,
'a dropped symbol plays naturally instead of becoming a held drawing');
await evaluate(`re_frame.core.dispatch(cljs.core.vector(cljs.core.keyword('arthur.events.ui/new-lane')))`);
await sleep(180);
s = await shot();
const renameControls = await evaluate('document.querySelectorAll(".tl-label .tl-rename").length');
assert.equal(renameControls, 2,
`both lanes expose rename controls: ${JSON.stringify(s.clip.symbols.main.nodes)}`);
await evaluate('document.querySelector(".tl-label .tl-rename").click()');
assert.equal(await evaluate('document.querySelectorAll(".tl-rename").length'), 1,
'the lane exposes its rename control');
await evaluate('document.querySelector(".tl-rename").click()');
await sleep(80);
assert(await evaluate(`(() => {
const input = document.querySelector('.tl-name-input');
if (!input) return false;
Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set.call(input, 'Foreground');
input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText', data: 'Foreground'}));
Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value')
.set.call(input, 'Foreground');
input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText'}));
input.blur(); return true;
})()`), 'lane rename editor opens');
await sleep(180);
s = await shot();
assert(Object.values(s.clip.symbols.main.nodes).some(n => n.layout === 'sequence' && n.name === 'Foreground'),
'a lane name is editable and persisted in the document');
assert(mainInstances(s).some(n => n.name === 'Foreground'), 'lane name persists');
await dragClipBetweenLanes(12);
s = await shot();
const lanes = Object.values(s.clip.symbols.main.nodes).filter(n => n.layout === 'sequence');
assert.deepEqual(lanes.map(l => instances(s).filter(n => n.parent === l.id).length).sort(), [1, 3],
'a clip body can move from one lane to another');
// EXPANDING A LANE OPENS THE SELECTED CLIP. Its own keys, and under it the
// lanes and nodes of the symbol it places, all on this ruler — which is what
// makes the whole document editable from the root timeline.
const rowLabels = () => evaluate(
`[...document.querySelectorAll('.tl-labels > .tl-label')].map(e => e.textContent.trim())`);
const twist = async i => {
assert(await evaluate(`(() => {
const t = document.querySelectorAll('.tl-labels > .tl-label .tl-twist')[${i}];
if (!t || t.disabled) return false;
t.click(); return true;
})()`), `an expander at row ${i}`);
await sleep(220);
};
await evaluate(`(() => { document.querySelector('.tl-track .tl-cel').click(); return true })()`);
await sleep(200);
const collapsed = await rowLabels();
await twist(0);
const opened = await rowLabels();
assert(opened.length > collapsed.length, 'the lane opens');
assert.equal(opened.filter(l => l.includes('instance')).length, 1,
`one clip portal, not one branch per clip: ${JSON.stringify(opened)}`);
const portalAt = opened.findIndex(l => l.includes('instance'));
await twist(portalAt);
const deep = await rowLabels();
assert(deep.length > opened.length,
`the portal opens the symbol the clip places: ${JSON.stringify(deep)}`);
// Selecting something nested must not close the portal that revealed it.
await evaluate(`(() => {
const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db);
const sel = cljs.core.get_in(db, [k('ui'), k('selection')]);
const path = cljs.core.nth(sel, 3);
re_frame.core.dispatch(cljs.core.vector(
k('arthur.events.ui/select'),
cljs.core.vector(k('node'), cljs.core.nth(sel, 1), cljs.core.nth(sel, 2),
cljs.core.conj(path, k('made-up-child')))));
return true;
// Drag a library symbol into the explicit lane. The row itself is the target;
// no temporary lane is previewed or created.
const drop = await evaluate(`(() => {
const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]');
const track = [...document.querySelectorAll('.tl-track')].find(t => t.arthurLane);
if (!source || !track) return null;
source.scrollIntoView({block: 'center'});
const a = source.getBoundingClientRect(), b = track.getBoundingClientRect();
return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * .085, ty: b.top + b.height / 2};
})()`);
await sleep(220);
assert.equal((await rowLabels()).filter(l => l.includes('instance')).length, 1,
'a selection under the clip keeps its portal open');
await twist(portalAt);
await twist(0);
assert(drop, 'a pool symbol and explicit lane are available');
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx, y: drop.sy});
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: drop.sx, y: drop.sy,
button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx + 12, y: drop.sy,
button: 'left', buttons: 1});
await sleep(100);
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.tx, y: drop.ty,
button: 'left', buttons: 1});
await sleep(120);
assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0,
'pool drop does not preview an invented lane');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel.ghost").length'), 1,
'pool drop previews inside the existing lane');
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: drop.tx, y: drop.ty,
button: 'left', buttons: 0, clickCount: 1});
await sleep(300);
s = await shot();
assert.equal(Object.keys(laneSymbols(s)[0].nodes).length, 1,
`the dropped clip remains in the explicit lane: ${JSON.stringify(s)}`);
assert.equal(laneSymbols(s).length, 1, 'the drop creates no extra lane');
const before = await tabs();
const tabChips = () => evaluate('document.querySelectorAll(".tabs .tab").length');
const chipsBefore = await tabChips();
await doubleClick('.tl-track .tl-cel');
const after = await tabs();
assert.equal(after.tabs.length, before.tabs.length + 1,
`double-clicking a clip opens the symbol it places, as the pool row does: ${JSON.stringify(after)}`);
assert(!before.tabs.includes(after.open) && after.tabs.includes(after.open),
`the opened symbol is the one in front: ${JSON.stringify(after)}`);
assert.equal(await tabChips(), chipsBefore + 1,
'the opened symbol is drawn as one more tab');
assert.equal(await evaluate('document.querySelectorAll("#app > *").length'), 1,
'opening from the timeline leaves the editor standing: a stale node selection ' +
'pointing into the symbol just left used to throw and unmount it');
// A second explicit lane is a sibling in the open symbol even though the
// first remains aimed. Move the clip between their linear tracks.
await clickNew('lane');
s = await shot();
assert.equal(laneSymbols(s).length, 2, 'a second explicit command creates a second lane');
const move = await evaluate(`(() => {
const tracks = [...document.querySelectorAll('.tl-track')].filter(t => t.arthurLane);
const from = tracks.find(t => t.querySelector('.tl-cel'));
const to = tracks.find(t => t !== from);
const cel = from?.querySelector('.tl-cel');
if (!cel || !to) return null;
const a = cel.getBoundingClientRect(), b = to.getBoundingClientRect();
return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * .12, ty: b.top + b.height / 2};
})()`);
assert(move, 'two explicit lanes and a source clip are available');
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: move.sx, y: move.sy,
button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: move.tx, y: move.ty,
button: 'left', buttons: 1});
await sleep(150);
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: move.tx, y: move.ty,
button: 'left', buttons: 0, clickCount: 1});
await sleep(300);
s = await shot();
assert.deepEqual(laneSymbols(s).map(x => Object.keys(x.nodes).length).sort(), [0, 1],
'a clip body moves from one explicit lane to the other');
assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: generic lanes preview, rename, move, place, open, trim, roll, and ripple clips');
console.log('PASS: symbols are ordinary; explicit lanes rename, accept drops, and exchange clips');
} finally {
if (ws?.readyState === WebSocket.OPEN) {
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' }));
await sleep(350);
}
ws?.close();
chrome.kill();
await new Promise(resolve => { if (chrome.exitCode !== null || chrome.signalCode !== null) resolve(); else chrome.once('exit', resolve); });
if (ws?.readyState === WebSocket.OPEN) ws.close();
chrome.kill('SIGTERM');
await new Promise(resolve => chrome.once('exit', resolve));
try {
rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 });
} catch (error) {
console.warn(`Temporary browser profile retained at ${profile}: ${error.code}`);
if (error.code !== 'ENOTEMPTY') throw error;
}
}