232 lines
12 KiB
Clojure
232 lines
12 KiB
Clojure
(ns arthur.events.lane-test
|
||
(:require [cljs.test :refer [deftest is]]
|
||
[arthur.domain.clip :as clip]
|
||
[arthur.domain.history :as history]
|
||
[arthur.domain.leaf :as leaf]
|
||
[arthur.domain.node :as node]
|
||
[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]
|
||
[re-frame.core :as rf]
|
||
[re-frame.db :as rf-db]))
|
||
|
||
(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 6}})
|
||
(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 :document saved :instance-id instance-id
|
||
:symbol (clip/symbol saved sid)})))]
|
||
(let [{ordinary :symbol} (run [::ui/new-symbol :inside] "explicit-symbol")
|
||
{lane :symbol lane-db :db document :document instance-id :instance-id}
|
||
(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 (= [0 (clip/frames document :main)]
|
||
(node/placed-span (get-in document [:symbols :main :nodes instance-id])))
|
||
"a lane exists across the open symbol, independent of the playhead")
|
||
(let [longer (assoc-in document [:symbols :main :frames] 300)
|
||
fitted (:clip (span/finish longer :main
|
||
(get-in longer [:symbols :main :nodes])
|
||
nil :keep))
|
||
lane-id (node/source (get-in fitted [:symbols :main :nodes instance-id]))]
|
||
(is (= [0 300]
|
||
(node/placed-span (get-in fitted [:symbols :main :nodes instance-id])))
|
||
"the lane follows a later change to its parent's extent")
|
||
(is (= 300 (clip/frames fitted lane-id))))
|
||
(is (some? (get-in lane-db [:ui :target]))
|
||
"the new lane is aimed so drawing and pool drops can go into it"))))
|
||
|
||
(deftest aiming-the-root-clears-selection-and-drawing-target
|
||
(let [db {:ui {:selection [:node :main :shape [:lane :shape]]
|
||
:target {:sid :main :id :lane :path [:lane]}}}
|
||
after (ui/aimed db nil)]
|
||
(is (nil? (get-in after [:ui :selection])))
|
||
(is (nil? (get-in after [:ui :target])))))
|
||
|
||
(deftest an-explicit-lane-is-one-row-of-clips
|
||
(let [doc (fixture/document)
|
||
rows (timeline/rows doc :main #{})
|
||
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))))))
|
||
|
||
(deftest a-nested-lane-is-drawn-in-the-open-symbols-frame-rate
|
||
(let [child {:id :cel :kind :instance :z "a" :span [0 2]
|
||
:time {:at 4 :rate 1}
|
||
:source {:symbol :drawing}
|
||
:playback {:in 0 :speed 0 :end :stop}}
|
||
placed {:id :take :kind :instance :z "a" :span [0 12]
|
||
:time {:at 0 :rate 1}
|
||
:source {:symbol :lane}
|
||
:playback {:in 0 :speed 1 :end :stop}}
|
||
doc (-> (clip/blank)
|
||
(assoc :fps 12)
|
||
(assoc-in [:symbols :main :fps] 12)
|
||
(assoc-in [:symbols :main :frames] 12)
|
||
(assoc-in [:symbols :main :nodes] {:take placed})
|
||
(assoc-in [:symbols :lane]
|
||
{:id :lane :fps 24 :frames 24 :display :lane
|
||
:nodes {:cel child}})
|
||
(assoc-in [:symbols :drawing]
|
||
{:id :drawing :fps 24 :frames 1 :nodes {}}))
|
||
lane (first (filter :lane? (timeline/rows doc :main #{})))]
|
||
(is (= [[2 3]] (mapv :span (:cels lane)))
|
||
"native frames 4–6 occupy ruler frames 2–3 at twice the frame rate")))
|
||
|
||
(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"
|
||
:time {:at 10 :rate 1} :span [0 12]
|
||
:source {:symbol :main}
|
||
:playback {:in 0 :speed 1 :end :stop}}}})]
|
||
(is (= 2 (ui/selection-frame doc nil :outer
|
||
[:node :main :a [:take :a]] 12)))
|
||
(is (= 12 (ui/selection-frame doc nil :main
|
||
[:node :main :a [:a]] 12)))))
|
||
|
||
(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 beginning-a-polygon-does-not-invent-a-lane
|
||
(let [doc (clip/blank)
|
||
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)))]
|
||
(is (= :polygon (get-in after [:ui :tool])))
|
||
(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-command-test")
|
||
db {:clip/current id :paint/revision 0
|
||
:ui {:open :main :selection [:node :main :a [:a]]}}
|
||
refused (ui/apply-command db :main
|
||
(span/extend-hold doc :main :a 1 {}) [:retry])]
|
||
(is (= doc (:clip (store/entry id))))
|
||
(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))))
|
||
(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 an-expanded-lane-opens-the-selected-clip
|
||
(let [doc (fixture/document)
|
||
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 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 #{})))))
|
||
|
||
(deftest aiming-the-open-lanes-own-row-is-a-selection-and-not-a-crash
|
||
;; `rows` names the open symbol's own lane row `[:node sid nil []]`, and
|
||
;; `selected` used to open the rows above a selection with `(pop path)` —
|
||
;; which THROWS on `[]`, aborting the whole event. Nothing was selected,
|
||
;; nothing was aimed, and the next polygon went wherever the stale target
|
||
;; still pointed, which is most of what made aiming a lane feel random.
|
||
(let [doc (fixture/document)
|
||
id (store/install! {:clip doc :store {}} "aim-the-open-lane")
|
||
db {:clip/current id :paint/revision 0
|
||
:ui {:open :main :target {:sid :main :id :a :path [:a]}}
|
||
:playback {:frame 0}}
|
||
lane (first (filter :lane? (timeline/rows doc :main #{})))
|
||
after (ui/aimed db (:select lane))]
|
||
(is (= [:node :main nil []] (:select lane)))
|
||
(is (= [:node :main nil []] (get-in after [:ui :selection])))
|
||
(is (nil? (get-in after [:ui :target]))
|
||
"the open symbol IS the place, so aiming its own row clears the target")
|
||
(is (= [] (ui/where-new-goes doc after)))
|
||
(is (empty? (get-in after [:ui :expanded]))
|
||
"and there are no rows above the top to open")))
|
||
|
||
(deftest finishing-a-polygon-opens-no-rows
|
||
;; Expansion is the twist triangle's business. Finishing a shape used to open
|
||
;; every row down to it, which inside a lane meant tearing its one row into a
|
||
;; portal, that clip's channels and every shape already in the drawing.
|
||
(let [doc (fixture/document)
|
||
id (store/install! {:clip doc :store {}} "finish-opens-nothing")
|
||
db {:clip/current id :paint/revision 0
|
||
:ui {:open :main :tool :polygon
|
||
:target {:sid :main :id :a :path [:a]}
|
||
:draft [10 10 40 10 40 40]}
|
||
:playback {:frame 1}}]
|
||
(reset! rf-db/app-db db)
|
||
(rf/dispatch-sync [::ui/finish-polygon])
|
||
(let [after @rf-db/app-db
|
||
[kind sid shape-id path] (get-in after [:ui :selection])]
|
||
(is (= :node kind))
|
||
(is (= :drawing-a sid) "the shape went into the drawing the aimed clip places")
|
||
(is (= [:a shape-id] path))
|
||
(is (empty? (get-in after [:ui :expanded])))
|
||
(is (nil? (get-in after [:ui :tool]))))))
|
||
|
||
(deftest a-clip-made-for-a-drawing-is-selected-in-the-symbol-it-lives-in
|
||
;; The clip `beginning-polygon` materializes lives in the symbol the LANE
|
||
;; draws. Naming the open one instead left a selection that looked up to
|
||
;; nothing, so the inspector, the breadcrumb and every span command went blank
|
||
;; on a drawing that had just been created.
|
||
(let [doc (-> (fixture/document)
|
||
;; The last of the lane's three clips taken out, so frames 8
|
||
;; to 12 are a gap and drawing there makes the held clip that
|
||
;; was missing rather than landing in one that is there.
|
||
(update-in [:symbols :main :nodes] dissoc :insert)
|
||
(assoc-in [:symbols :shot]
|
||
{:id :shot :fps 24 :frames 12
|
||
: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}}}}))
|
||
id (store/install! {:clip doc :store {}} "clip-selected-where-it-lives")
|
||
db {:clip/current id :paint/revision 0
|
||
:ui {:open :shot :target {:sid :shot :id :girl :path [:girl]}}
|
||
:playback {:frame 9}}
|
||
after (ui/beginning-polygon db)
|
||
[_ sid clip-id path] (get-in after [:ui :selection])
|
||
saved (:clip (store/entry id))]
|
||
(is (= :main sid) "the lane's symbol, not the open one")
|
||
(is (= [:girl clip-id] path))
|
||
(is (some? (get-in saved [:symbols :main :nodes clip-id]))
|
||
"and that is where the node actually is")))
|