92 lines
4.1 KiB
Clojure
92 lines
4.1 KiB
Clojure
(ns arthur.domain.span-test
|
|
"Generic span edits in an explicit lane and an ordinary compositing symbol."
|
|
(:require [cljs.test :refer [deftest is testing]]
|
|
[arthur.domain.clip :as clip]
|
|
[arthur.domain.node :as node]
|
|
[arthur.domain.palette :as pal]
|
|
[arthur.domain.sequence-test :as fixture]
|
|
[arthur.domain.span :as span]))
|
|
|
|
(defn document [] (fixture/document))
|
|
|
|
(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)]
|
|
(into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs)))
|
|
|
|
(defn- drawn [doc fs]
|
|
(let [at (sample doc fs)]
|
|
(mapv #(sort (vals (get at %))) fs)))
|
|
|
|
(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 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)]
|
|
(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 #"whole shot" (:refused (span/split doc :main :plate 2 :right))))))
|
|
|
|
(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 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 doc :main :badge 2 {})))))
|
|
|
|
(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 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 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))))
|