Unify lane overlap and nested timing
This commit is contained in:
Your Name
parent
1b2b4ad3d2
commit
8f09b7b47f
6 changed files with 140 additions and 86 deletions
|
|
@ -454,7 +454,7 @@
|
|||
;; a boundary can be rolled depend on which of them `some` reaches
|
||||
;; first. `finish` does the same `problems` check and the overlap one
|
||||
;; too, so this is less code and one fewer invariant to remember.
|
||||
(span/finish clip (:sid here) moved id :grow-symbol)))))
|
||||
(span/claim clip (:sid here) moved id :grow-symbol (random-uuid))))))
|
||||
|
||||
(defn resize-out
|
||||
"Move the right edge of the node at `path` by `df` frames of `open`.
|
||||
|
|
|
|||
|
|
@ -144,6 +144,47 @@
|
|||
[n which f]
|
||||
(assoc-in n [:span (case which :in 0 :out 1)] (local n f)))
|
||||
|
||||
(defn claim
|
||||
"Commit proposed `nodes`, with `id` claiming its interval in lane mode.
|
||||
|
||||
This is the one difference between editing a lane and a composition. In a
|
||||
composition it is exactly `finish`. In a lane, immediately before that same
|
||||
commit, clips covered by the edited one are removed and clips crossing either
|
||||
edge are trimmed. A clip crossing both edges is split and therefore needs a
|
||||
caller-supplied `remainder-id`."
|
||||
[clip sid nodes id extent remainder-id]
|
||||
(let [n (get nodes id)
|
||||
lane-child? (and (symbol/lane? (clip/symbol clip sid))
|
||||
n (nil? (:parent n)) (node/placed-span n))]
|
||||
(if-not lane-child?
|
||||
(finish clip sid nodes id extent)
|
||||
(let [[a b] (node/placed-span n)
|
||||
others (remove #(= id (:id %)) (symbol/children nodes))
|
||||
spanning (first (filter #(let [[lo hi] (node/placed-span %)]
|
||||
(and (< lo a) (> hi b)))
|
||||
others))]
|
||||
(if (and spanning (or (nil? remainder-id) (contains? nodes remainder-id)))
|
||||
{:refused "claiming time inside one clip needs a free ID for its remainder"}
|
||||
(finish
|
||||
clip sid
|
||||
(reduce
|
||||
(fn [ns other]
|
||||
(let [oid (:id other)
|
||||
[lo hi] (node/placed-span other)]
|
||||
(cond
|
||||
(or (<= hi a) (>= lo b)) ns
|
||||
(and (< lo a) (> hi b))
|
||||
(-> ns
|
||||
(assoc oid (edged other :out a))
|
||||
(assoc remainder-id
|
||||
(assoc (edged other :in b) :id remainder-id
|
||||
:z (str "a-" remainder-id))))
|
||||
(and (>= lo a) (<= hi b)) (dissoc ns oid)
|
||||
(< lo a) (assoc ns oid (edged other :out a))
|
||||
:else (assoc ns oid (edged other :in b)))))
|
||||
nodes others)
|
||||
id extent))))))
|
||||
|
||||
(defn host-frame
|
||||
"Symbol frame `f` as a frame of the space node `id` is POSITIONED in — its
|
||||
parent's — which is the frame space every command here takes its coordinate
|
||||
|
|
@ -335,7 +376,7 @@
|
|||
(let [nodes (get-in clip [:symbols sid :nodes])
|
||||
{:keys [node refused]} (subject nodes id)
|
||||
[lo old-out] (when node (node/placed-span node))
|
||||
later (when node
|
||||
later (when (and node ripple?)
|
||||
(filter #(>= (first (node/placed-span %)) old-out)
|
||||
(siblings clip sid nodes id)))]
|
||||
(cond
|
||||
|
|
@ -346,22 +387,10 @@
|
|||
:else
|
||||
(let [delta (- to old-out)
|
||||
resized (assoc nodes id (edged node :out to))
|
||||
changed
|
||||
(if ripple?
|
||||
(reduce (fn [ns sibling]
|
||||
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
|
||||
resized later)
|
||||
(if (pos? delta)
|
||||
(reduce
|
||||
(fn [ns sibling]
|
||||
(let [[s e] (node/placed-span sibling)]
|
||||
(cond
|
||||
(>= s to) ns
|
||||
(<= e to) (dissoc ns (:id sibling))
|
||||
:else (assoc ns (:id sibling) (edged sibling :in to)))))
|
||||
resized later)
|
||||
resized))]
|
||||
(finish clip sid changed id extent)))))
|
||||
changed (reduce (fn [ns sibling]
|
||||
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
|
||||
resized later)]
|
||||
(claim clip sid changed id extent nil)))))
|
||||
|
||||
(defn resize-in
|
||||
"Put clip `id`'s left edge at parent frame `to`. Shrinking leaves a gap;
|
||||
|
|
@ -369,29 +398,14 @@
|
|||
[clip sid id to]
|
||||
(let [nodes (get-in clip [:symbols sid :nodes])
|
||||
{:keys [node refused]} (subject nodes id)
|
||||
[old-in hi] (when node (node/placed-span node))
|
||||
earlier (when node
|
||||
(filter #(<= (second (node/placed-span %)) old-in)
|
||||
(siblings clip sid nodes id)))]
|
||||
[old-in hi] (when node (node/placed-span node))]
|
||||
(cond
|
||||
refused {:refused refused}
|
||||
(not (integer? to)) {:refused "an edge goes to a whole frame"}
|
||||
(not (< to hi)) {:refused "a clip must keep at least one frame"}
|
||||
(neg? to) {:refused "a clip cannot begin before the shot"}
|
||||
(= to old-in) {:clip clip :selection id}
|
||||
:else
|
||||
(let [resized (assoc nodes id (edged node :in to))
|
||||
changed (if (< to old-in)
|
||||
(reduce
|
||||
(fn [ns sibling]
|
||||
(let [[s e] (node/placed-span sibling)]
|
||||
(cond
|
||||
(<= e to) ns
|
||||
(>= s to) (dissoc ns (:id sibling))
|
||||
:else (assoc ns (:id sibling) (edged sibling :out to)))))
|
||||
resized earlier)
|
||||
resized)]
|
||||
(finish clip sid changed id :keep)))))
|
||||
:else (claim clip sid (assoc nodes id (edged node :in to)) id :keep nil))))
|
||||
|
||||
(defn roll
|
||||
"Move the shared boundary between adjacent clips `left-id` and `right-id`.
|
||||
|
|
@ -460,17 +474,6 @@
|
|||
;; selected rather than being handed a clip it did not ask for.
|
||||
(finish clip sid nodes (when spanning id) :keep)))))
|
||||
|
||||
(defn- cleared
|
||||
"`clip` with frames `[at (+ at duration))` of `sid` emptied where `sid` is drawn
|
||||
as a lane, and untouched where it is not: outside lane mode a placement does not
|
||||
claim time, because being on screen together is what compositing IS.
|
||||
|
||||
`{:clip c}` or `{:refused why}`, so one `if-let` covers both."
|
||||
[clip sid at duration remainder-id]
|
||||
(if-not (symbol/lane? (clip/symbol clip sid))
|
||||
{:clip clip}
|
||||
(blank clip sid [at (+ at duration)] {:id remainder-id})))
|
||||
|
||||
(defn extend-hold
|
||||
"Change one held clip's duration by `delta` frames and ripple its later
|
||||
siblings. Keys, source clocks and the clips' own channels stay put.
|
||||
|
|
@ -528,12 +531,8 @@
|
|||
(and remainder-id (contains? nodes remainder-id))
|
||||
{:refused "the remainder clip needs a free ID"}
|
||||
:else
|
||||
(let [room (cleared clip sid at duration remainder-id)]
|
||||
(if (:refused room)
|
||||
room
|
||||
(let [placed (update-in n [:time :at] (fnil + 0) (- at lo))
|
||||
nodes (assoc (get-in (:clip room) [:symbols sid :nodes]) id placed)]
|
||||
(finish (:clip room) sid nodes id extent)))))))
|
||||
(let [placed (update-in n [:time :at] (fnil + 0) (- at lo))]
|
||||
(claim clip sid (assoc nodes id placed) id extent remainder-id)))))
|
||||
|
||||
(defn place-symbol
|
||||
"Materialize an instance of `source-id`, then place it into `sid` at `at`.
|
||||
|
|
@ -746,12 +745,11 @@
|
|||
"the remainder clip needs a free ID different from the new clip"
|
||||
(clip/symbol clip drawing-id) "the new drawing ID is already used")]
|
||||
{:refused why}
|
||||
(let [room (cleared clip sid at 1 remainder-id)]
|
||||
(if (:refused room)
|
||||
room
|
||||
(place (assoc-in (:clip room) [:symbols drawing-id]
|
||||
{:id drawing-id :name (name drawing-id) :fps (clip/fps clip sid) :frames 1 :nodes {}})
|
||||
sid id drawing-id at extent false))))))
|
||||
(let [c (assoc-in clip [:symbols drawing-id]
|
||||
{:id drawing-id :name (name drawing-id)
|
||||
:fps (clip/fps clip sid) :frames 1 :nodes {}})
|
||||
nodes (assoc nodes id (held id drawing-id at))]
|
||||
(claim c sid nodes id extent remainder-id)))))
|
||||
|
||||
(defn make-unique
|
||||
"Point clip `id` at a private copy of its content, leaving every other
|
||||
|
|
|
|||
|
|
@ -696,9 +696,9 @@
|
|||
::drop-clear
|
||||
(fn [db _] (update db :ui dissoc :drop)))
|
||||
|
||||
(defn drop-destination
|
||||
"Which symbol a drop lands in and on which of its frames: `{:clip :sid :at
|
||||
:path}`, or `{:refused why}`.
|
||||
(defn drop-destination-at
|
||||
"Which symbol a drop on `target` lands in and on which of its frames:
|
||||
`{:clip :sid :at :path}`, or `{:refused why}`.
|
||||
|
||||
ONE RULE AND EVERY DROP ASKS IT — a symbol from the pool, a sound, and a video
|
||||
brought in as a take alike. The pointer names a ROW, `target`, and a row leads
|
||||
|
|
@ -714,12 +714,11 @@
|
|||
`:clip` is handed back unchanged and is in the result only so the callers that
|
||||
used to be given a document with a freshly made lane in it go on reading one
|
||||
thing."
|
||||
[db document st frame target]
|
||||
[document st open frame target]
|
||||
(let [target (if (vector? target)
|
||||
(let [[_ sid id path] target]
|
||||
{:sid sid :id id :path path})
|
||||
target)
|
||||
open (get-in db [:ui :open])
|
||||
path (cond
|
||||
(nil? target) []
|
||||
(= :instance (get-in document [:symbols (:sid target)
|
||||
|
|
@ -732,6 +731,11 @@
|
|||
(not (integer? at)) {:refused "the drop is not on one frame of that symbol"}
|
||||
:else {:clip document :sid sid :at at :path path})))
|
||||
|
||||
(defn drop-destination
|
||||
"`drop-destination-at` from the symbol currently open in `db`."
|
||||
[db document st frame target]
|
||||
(drop-destination-at document st (get-in db [:ui :open]) frame target))
|
||||
|
||||
(defn landed
|
||||
"`db` after a drop that produced `result`, with `uuid` selected."
|
||||
[db {:keys [sid path]} uuid result]
|
||||
|
|
|
|||
|
|
@ -43,9 +43,16 @@
|
|||
;; ---------------------------------------------------------------------------
|
||||
;; the rows
|
||||
|
||||
(defn- time->parent
|
||||
"The inverse of a time map: where one of its output frames sits in its input."
|
||||
[{:keys [at rate]}]
|
||||
(if (and (zero? at) (= 1 rate))
|
||||
identity
|
||||
(fn [f] (+ at (/ f rate)))))
|
||||
|
||||
(defn- local->parent
|
||||
"The inverse of a node's time map: where a frame of its OWN time sits in the
|
||||
symbol it lives in. See `node/time-of`.
|
||||
"Where a frame of a node's OWN time sits in the symbol it lives in.
|
||||
See `node/time-of`.
|
||||
|
||||
Two frame spaces meet at every node and mixing them up is the bug this exists
|
||||
to prevent: a placement `:at 48` whose scale is keyed at 0 has that key on
|
||||
|
|
@ -56,10 +63,7 @@
|
|||
frame the exposure grid never samples is still authored on that frame, and that
|
||||
is where the row should show it."
|
||||
[n]
|
||||
(let [{:keys [at rate]} (node/time-of n)]
|
||||
(if (and (zero? at) (= 1 rate))
|
||||
identity
|
||||
(fn [f] (+ at (/ f rate))))))
|
||||
(time->parent (node/time-of n)))
|
||||
|
||||
(defn- keyed-frames [ch] (some-> (:keys ch) keys sort))
|
||||
|
||||
|
|
@ -131,8 +135,8 @@
|
|||
;; the key positions, and the bars that would imply them. Refuse
|
||||
;; rather than guess, without refusing the whole subtree.
|
||||
(when-let [source (and (= :instance (:kind n)) (node/source n))]
|
||||
(if-let [{:keys [at rate]} (clip/source-time clip sid n)]
|
||||
(walk source path depth (comp self #(+ at (/ % rate))))
|
||||
(if-let [source-time (clip/source-time clip sid n)]
|
||||
(walk source path depth (comp self (time->parent source-time)))
|
||||
(mapv (fn [row]
|
||||
(-> row
|
||||
(assoc :keys [] :unmapped? true)
|
||||
|
|
@ -244,6 +248,13 @@
|
|||
self (comp parent-map (local->parent n))
|
||||
source-sym (when (= :instance (:kind n))
|
||||
(clip/symbol clip (node/source n)))
|
||||
;; `self` maps the instance's local clock. Rows of
|
||||
;; the symbol it places use its source clock too,
|
||||
;; including the native-FPS ratio.
|
||||
source-self (if-let [t (and source-sym
|
||||
(clip/source-time clip sid n))]
|
||||
(comp self (time->parent t))
|
||||
self)
|
||||
lane? (symbol/lane? source-sym)
|
||||
clips (when lane? (symbol/children (:nodes source-sym)))
|
||||
span (mapv parent-map
|
||||
|
|
@ -283,13 +294,13 @@
|
|||
:label (or (get-in clip [:symbols (node/source child) :name])
|
||||
(some-> (node/source child) name))
|
||||
:source (node/source child)
|
||||
:span (mapv self (node/placed-span child))
|
||||
:span (mapv source-self (node/placed-span child))
|
||||
;; The clip's own keys, on the
|
||||
;; block, so a collapsed lane
|
||||
;; still says where it changes.
|
||||
:keys (into []
|
||||
(comp (mapcat keyed-frames)
|
||||
(map (comp self (local->parent child)))
|
||||
(map (comp source-self (local->parent child)))
|
||||
(distinct))
|
||||
(vals (node/channels child)))
|
||||
:select [:node (node/source n) (:id child)
|
||||
|
|
@ -302,7 +313,7 @@
|
|||
;; The one clip an expanded lane opens.
|
||||
(into (when lane?
|
||||
(if-let [child (first (filter #(under? (conj rpath (:id %))) clips))]
|
||||
(portal (node/source n) rpath (inc depth) self child)
|
||||
(portal (node/source n) rpath (inc depth) source-self child)
|
||||
[{:path (conj rpath ::portal)
|
||||
:depth (inc depth)
|
||||
:kind :hint
|
||||
|
|
@ -587,7 +598,6 @@
|
|||
(if (= :instance node-kind) " drop-into" " drop-group"))))
|
||||
:style {:padding-left (str (+ 4 (* 11 depth)) "px")}
|
||||
:title label
|
||||
:tab-index (when lane? 0)
|
||||
:ref (when (and select (= select selection)) (reveal selection))
|
||||
;; A LABEL AIMS. Clicking a row's name says "I am working
|
||||
;; here", which is a statement about a place in the document;
|
||||
|
|
@ -597,13 +607,8 @@
|
|||
:on-click #(when select (rf/dispatch [::ui/aim select]))
|
||||
;; An instance's row opens the symbol it places, as a tab.
|
||||
:on-double-click (fn [^js e]
|
||||
(cond lane? (do (.stopPropagation e) (begin-rename!))
|
||||
of (rf/dispatch [::pb/open-symbol of])))
|
||||
:on-key-down (when lane?
|
||||
(fn [^js e]
|
||||
(when (= "F2" (.-key e))
|
||||
(.preventDefault e)
|
||||
(begin-rename!))))}
|
||||
(when of
|
||||
(rf/dispatch [::pb/open-symbol of])))}
|
||||
;; A node's row can be dragged onto another: onto an instance's, to
|
||||
;; go inside the symbol it places; onto any other node's, to be
|
||||
;; grouped with it into a new one; onto an edge of either, to be
|
||||
|
|
@ -667,7 +672,7 @@
|
|||
node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))])
|
||||
(when lane?
|
||||
[:button.tl-rename
|
||||
{:title "rename lane (F2)"
|
||||
{:title "rename lane"
|
||||
:on-click (fn [^js e] (.stopPropagation e) (begin-rename!))}
|
||||
"✎"])
|
||||
;; A face's row is where its own footage is switched on, next to solo
|
||||
|
|
@ -734,10 +739,22 @@
|
|||
(not= (:select under) (:selection drag)))
|
||||
under)
|
||||
[target-el target] (when (and drag (not shift?)) (lane-under e))
|
||||
landing? (some? target)
|
||||
target-at (when target
|
||||
(frame-under e frames target-el))
|
||||
;; A cel moved on its OWN lane is a normal slide.
|
||||
;; Resolve the row under the pointer before calling
|
||||
;; it a transfer: comparing the displayed rows is
|
||||
;; not enough when the lane is reached through an
|
||||
;; instance. This leaves one slide gesture and one
|
||||
;; coordinate conversion; lane overlap trimming is
|
||||
;; the domain command's only additional policy.
|
||||
target-sid (when target
|
||||
(:sid (ui/drop-destination-at
|
||||
clip store open target-at target)))
|
||||
landing? (and target-sid
|
||||
(not= target-sid (nth (:selection drag) 1)))
|
||||
target-frame (when landing?
|
||||
(max 0 (- (frame-under e frames target-el)
|
||||
(:grab drag))))]
|
||||
(max 0 (- target-at (:grab drag))))]
|
||||
(when (and drag hint)
|
||||
(reset! hint
|
||||
{:x (.-clientX e) :y (.-clientY e)
|
||||
|
|
|
|||
|
|
@ -356,3 +356,15 @@
|
|||
(is (= [22 23] (node/placed-span (get-in slid [:symbols :lane :nodes :b]))))
|
||||
(is (= 1 (:rate (get-in slid [:symbols :lane :nodes :b :time])))
|
||||
"and the rest of its map is still there")))
|
||||
|
||||
(deftest sliding-in-a-lane-claims-overlapped-time
|
||||
;; The gesture is `nest/slide` in both display modes. Lane mode contributes
|
||||
;; only the placement rule at commit: the moved cel replaces what it covers.
|
||||
(let [c (on-twos)
|
||||
r (nest/slide c :lane [:b] -14)
|
||||
slid (:clip r)]
|
||||
(is (nil? (:refused r)) (:refused r))
|
||||
(is (= [5 6] (node/placed-span (get-in slid [:symbols :lane :nodes :b]))))
|
||||
(is (nil? (get-in slid [:symbols :lane :nodes :a]))
|
||||
"a fully covered neighbor is removed")
|
||||
(is (empty? (clip/problems slid)))))
|
||||
|
|
|
|||
|
|
@ -63,6 +63,29 @@
|
|||
[: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 #{})]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue