diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs index e350b00..42c82df 100644 --- a/frontend/src/arthur/domain/nest.cljs +++ b/frontend/src/arthur/domain/nest.cljs @@ -228,6 +228,81 @@ (node/mul! (node/mat) inv (:matrix here)) (node/then-time (node/invert-time b) a))))) +(defn- down + "Walk row path `path` down from symbol `sid` by structure alone: `{:sid + :time}`, the symbol it leads to and the time map from `sid`'s frames to that + symbol's own, nil through a loop. + + `inside` without the frame. Which symbol a row is in and how fast it runs + there are the same on every frame, so asking needs nothing to be on screen; + only a move that keeps the PICTURE needs a frame, for the matrix." + [clip sid path] + (let [sids (reductions #(get-in clip [:symbols %1 :nodes %2 :of]) sid path) + ;; Every node on the way, outermost first: each instance, after its + ;; parents in the symbol it is in. + chain (mapcat (fn [sid id] + (let [nodes (:nodes (clip/symbol clip sid))] + (map #(get nodes %) (rseq (symbol/lineage nodes id))))) + sids path)] + {:sid (last sids) + :time (when (not-any? #(get-in % [:time :loop?]) chain) + (reduce node/then-time {:at 0 :rate 1} (map node/time-of chain)))})) + +(defn slide + "Move the node at row path `path` along its symbol's time by `df` frames of + `open`. `{:clip}` or `{:refused why}`. + + ONE WRITE TO `:at`, for every node alike: its span, keys and children are in + its own frames and come with it. `df` is carried down into the frames `:at` is + in — the symbol's, through each instance on the way, and its parents' there." + [clip open path df] + (let [here (down clip open (pop path)) + id (peek path) + nodes (:nodes (clip/symbol clip (:sid here)))] + (cond + (nil? (get nodes id)) {:refused "nothing to move"} + (nil? (:time here)) {:refused "a looping instance is in the way"} + :else + (let [chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) + d (* df (:rate (reduce node/then-time (:time here) (map node/time-of chain))))] + {:clip (clip/update-symbol + clip (:sid here) update-in [:nodes id] + (fn [n] + (if (= :map (get-in n [:time :mode])) + (update-in n [:time :at] (fnil + 0) d) + (assoc n :time {:mode :map :at d :rate 1}))))})))) + +(defn restack + "Put the node at row path `from` just in front of the one at `to` when + `front?`, or just behind it — side by side in one symbol, as the timeline lists + them. `{:clip :sid :id}` or `{:refused why}`. + + ONE WRITE TO `:z`, between the two it lands between, so nothing else is + renumbered. Among the nodes that share its parent, because that is what `:z` + orders; a roto part's parent is the rig, and it restacks within that." + [clip open from to front?] + (let [{sid :sid} (down clip open (pop to)) + nodes (:nodes (clip/symbol clip sid)) + n (get nodes (peek from)) + t (get nodes (peek to)) + z #(or (:z %) "") + zs (->> nodes + (keep (fn [[k m]] (when (and (= (:parent m) (:parent t)) (not= k (peek from))) + (z m)))) + sort)] + (cond + (not= (pop from) (pop to)) {:refused "only things side by side can be restacked"} + (or (nil? n) (nil? t)) {:refused "nothing to restack"} + (not= (:parent n) (:parent t)) {:refused "they hang off different parents"} + :else + {:sid sid + :id (peek from) + :clip (clip/update-symbol + clip sid assoc-in [:nodes (peek from) :z] + (if front? + (symbol/z-between (z t) (first (filter #(pos? (compare % (z t))) zs))) + (symbol/z-between (last (filter #(neg? (compare % (z t))) zs)) (z t))))}))) + (defn group "Put the nodes at row paths `froms`, all side by side in one symbol, into a NEW symbol `sid`, placed where they were by instance `uuid`. `{:clip}` or diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index 54e6472..54485b5 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -110,6 +110,30 @@ [nodes id] (mapv #(:z (get nodes %)) (rseq (lineage nodes id)))) +(defn z-between + "A `:z` that sorts strictly between `a` and `b`, which must be in order; nil + for either is no bound on that side. What makes restacking one write. + + The midpoint of the first character they differ in, when there is room. When + there is not, anything that starts with `a` and is longer sorts after it, and + before `b` too unless `a` is a prefix of `b` — and then the room is found one + character further into `b`. \"0\" is the floor, and nothing this makes ends + in it, so there is always a further character to go to; only an authored key + ending in \"0\" leaves none, and then one character less than it does." + [a b] + (let [a (or a "")] + (if (nil? b) + (str a "m") + (let [i (count (take-while true? (map = a b))) + hi (.charCodeAt b i) + lo (if (< i (count a)) (.charCodeAt a i) 48) + mid (quot (+ lo hi) 2)] + (cond + (> mid lo) (str (subs b 0 i) (char mid)) + (< i (count a)) (str a "m") + (< (inc i) (count b)) (str (subs b 0 (inc i)) (z-between nil (subs b (inc i)))) + :else (str (subs b 0 i) (char (dec hi)) "m")))))) + (defn- z-lex "Lexicographic compare of two z paths, a prefix sorting first. diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index f1b3865..e7d6d00 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -176,6 +176,47 @@ (assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj to (:id r))]) (update-in [:ui :expanded] into (rest (reductions conj [] to)))))))) +(rf/reg-event-db + ::sliding + ;; A bar in the middle of a slide, drawn by `::render/clip`; nil path when the + ;; drag is abandoned. + (fn [db [_ path df]] + (if path + (assoc-in db [:ui :sliding] {:path path :df df}) + (update db :ui dissoc :sliding)))) + +(rf/reg-event-db + ::slide + (fn [db [_ path df]] + (let [db (update db :ui dissoc :sliding) + r (nest/slide (:clip (store/entry (:clip/current db))) (get-in db [:ui :open]) path df)] + (cond + (zero? df) db + (:refused r) (refused db (:refused r)) + :else (edit/edit db (constantly (:clip r))))))) + +(rf/reg-event-db + ::restack + ;; Onto the edge of a row in another symbol, it goes into that symbol first: + ;; one gesture, as in a layers panel, for where it lives and where in the stack. + (fn [db [_ from to front?]] + (let [{clip :clip st :store} (store/entry (:clip/current db)) + open (get-in db [:ui :open]) + f (get-in db [:playback :frame]) + host (pop to) + moved (if (= host (pop from)) + {:clip clip :id (peek from)} + (nest/move-node clip st open from host f)) + r (if (:refused moved) + moved + (nest/restack (:clip moved) open (conj host (:id moved)) to front?))] + (if-let [why (:refused r)] + (refused db why) + (-> db + (edit/edit (constantly (:clip r))) + (assoc-in [:ui :selection] [:node (:sid r) (:id r) (conj host (:id r))]) + (update-in [:ui :expanded] into (rest (reductions conj [] host)))))))) + (rf/reg-event-db ::group (fn [db [_ froms]] diff --git a/frontend/src/arthur/subs/render.cljs b/frontend/src/arthur/subs/render.cljs index 49b7032..60f30c3 100644 --- a/frontend/src/arthur/subs/render.cljs +++ b/frontend/src/arthur/subs/render.cljs @@ -8,6 +8,7 @@ recomputation here and a frame costs a lookup and a blit — and, crucially, the playhead is not an input, so moving it cannot invalidate this." (:require [arthur.domain.clip :as clip] + [arthur.domain.nest :as nest] [arthur.domain.palette :as pal] [arthur.footage.store :as footage] [arthur.subs.playback :as playback] @@ -16,13 +17,23 @@ (rf/reg-sub ::clip-id (fn [db _] (:clip/current db))) (rf/reg-sub ::paint-revision (fn [db _] (:paint/revision db))) +(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open]))) +(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding]))) + (rf/reg-sub ::clip :<- [::clip-id] :<- [::paint-revision] - (fn [[id _] _] (:clip (footage/entry id)))) - -(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open]))) + :<- [::sliding] + :<- [::open] + (fn [[id _ sliding open] _] + ;; With a timeline bar being slid, the document as it will be when the drag + ;; lets go, so the stage and the rows follow the pointer. Nothing is written + ;; until then: one drag is one undo step and one write to collaborators. + (let [c (:clip (footage/entry id))] + (or (when-let [{:keys [path df]} sliding] + (:clip (nest/slide c open path df))) + c)))) (rf/reg-sub ::symbol diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index 45c513d..09e3d06 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -195,13 +195,25 @@ (when-let [from (drag/row)] (not= from (subvec target 0 (min (count from) (count target)))))) +(defn- zone + "Which part of a row the pointer is over: its top edge, to go in front of it; + its bottom edge, to go behind; its middle, to go into it or be grouped with it." + [^js e] + (let [box (.getBoundingClientRect (.-currentTarget e)) + y (/ (- (.-clientY e) (.-top box)) (max 1 (.-height box)))] + (cond (< y 0.3) :front (> y 0.7) :back :else :into))) + (defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of]} selection over] - (let [node? (= :node kind)] + (let [node? (= :node kind) + [over-path where] @over] [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on") (when (= :ghost kind) " ghost") - (when (= path @over) - (if (= :instance node-kind) " drop-into" " drop-group"))) + (when (= path over-path) + (case where + :front " drop-front" + :back " drop-back" + (if (= :instance node-kind) " drop-into" " drop-group")))) :style {:padding-left (str (+ 4 (* 11 depth)) "px")} :title label :on-click #(when select (rf/dispatch [::ui/select select])) @@ -209,7 +221,9 @@ :on-double-click #(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. Both keep the picture as it is. + ;; grouped with it into a new one; onto an edge of either, to be + ;; restacked in front of it or behind it, in whichever symbol it is + ;; in. All of them keep the picture as it is, but for the stacking. node? (merge {:draggable true :on-drag-start (fn [^js e] (.stopPropagation e) @@ -223,18 +237,21 @@ (.preventDefault e) (.stopPropagation e) (set! (.. e -dataTransfer -dropEffect) "move") - (when (not= path @over) (reset! over path)))) + (let [o [path (zone e)]] + (when (not= o @over) (reset! over o))))) :on-drop (fn [^js e] (.preventDefault e) (.stopPropagation e) - (let [from (when (takes? path) (drag/row))] + (let [from (when (takes? path) (drag/row)) + where (zone e)] (reset! over nil) (drag/done!) (when from (rf/dispatch - (if (= :instance node-kind) - [::ui/move-node from path] - [::ui/group [from path]])))))})) + (cond + (not= :into where) [::ui/restack from path (= :front where)] + (= :instance node-kind) [::ui/move-node from path] + :else [::ui/group [from path]])))))})) [:button.tl-twist {:disabled (not expandable?) :on-click (fn [^js e] @@ -244,26 +261,62 @@ [:span.name label] (when node? [:span.kind (str "·" (name node-kind))])])) -(defn- track-cell [{:keys [span keys dense? kind]} frames] - [:div.tl-track - ;; Clipped to the ruler: an instance longer than the room left in its - ;; symbol still plays its own frames from 0, it is just cut off at the end. - (when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])] - (when (< in out) - [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")) - :style {:left (edge% in frames) - :width (str (* 100 (/ (- out in) (max 1 frames))) "%")}}])) - ;; A dense channel has a value on every frame, so ticking each one is a solid - ;; block that says less than the bar behind it already does. - (when-not dense? - (doall - (for [f keys :when (and (<= 0 f) (< f frames))] - ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))]) +(defn- track-cell + "`sliding` is the pointer's side of a bar being dragged, `{:path :x :width + :df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every + row and the stage are drawn from already has in it." + [{:keys [path span keys dense? kind select]} frames sliding] + (let [{from :path x0 :x width :width} @sliding + slide (fn [^js e] + (when (= path from) + (let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))] + (when (not= df (:df @sliding)) + (swap! sliding assoc :df df) + (rf/dispatch [::ui/sliding path df]))))) + done (fn [commit?] + (when (= path from) + (let [df (:df @sliding)] + (reset! sliding nil) + (rf/dispatch (if commit? [::ui/slide path df] [::ui/sliding nil])))))] + [:div.tl-track + ;; The track, not the bar, holds the pointer while a bar slides, so the drag + ;; goes on when the bar has slid off the ruler and is no longer drawn. + {:on-pointer-move slide + :on-pointer-up (fn [e] (slide e) (done true)) + :on-pointer-cancel (fn [_] (done false))} + ;; Clipped to the ruler: an instance longer than the room left in its + ;; symbol still plays its own frames from 0, it is just cut off at the end. + (when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])] + (when (< in out) + [:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost") + (when select " movable") (when (= path from) " sliding")) + :style {:left (edge% in frames) + :width (str (* 100 (/ (- out in) (max 1 frames))) "%")} + :on-pointer-down + (when select + (fn [^js e] + (let [track (.. e -currentTarget -parentElement)] + (.stopPropagation e) + (rf/dispatch [::ui/select select]) + (reset! sliding {:path path :x (.-clientX e) :df 0 + :width (.-width (.getBoundingClientRect track))}) + ;; As on the ruler: an enhancement that throws on a pointer + ;; the browser has no record of. + (try (.setPointerCapture track (.-pointerId e)) + (catch :default _ nil)))))}])) + ;; A dense channel has a value on every frame, so ticking each one is a solid + ;; block that says less than the bar behind it already does. + (when-not dense? + (doall + (for [f keys :when (and (<= 0 f) (< f frames))] + ^{:key f} [:div.tl-key {:style {:left (at% f frames)}}])))])) (defn view [] (r/with-let [scrubbing (r/atom false) - ;; The row a carried row is over, for the highlight. - over (r/atom nil)] + ;; The row a carried row is over and which part of it, for the + ;; highlight. + over (r/atom nil) + sliding (r/atom nil)] (let [clip @(rf/subscribe [::render/clip]) frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frame @(rf/subscribe [::playback/frame]) @@ -345,6 +398,6 @@ ^{:key f} [:div.tick {:style {:left (edge% f frames)}} f]))] (if (seq visible) (doall (for [row visible] - ^{:key (str (:path row))} [track-cell row frames])) + ^{:key (str (:path row))} [track-cell row frames sliding])) [:div.tl-empty "nothing in this symbol"]) [:div.tl-playhead {:style {:left (at% frame frames)}}]]]]))) diff --git a/frontend/test/arthur/domain/nest_test.cljs b/frontend/test/arthur/domain/nest_test.cljs index a648772..ebc313b 100644 --- a/frontend/test/arthur/domain/nest_test.cljs +++ b/frontend/test/arthur/domain/nest_test.cljs @@ -192,3 +192,49 @@ (select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate])) "half speed inside something at double speed, so it runs as it did") (is (= (picture c :main fs) (picture moved :main fs))))) + +(deftest sliding-a-shape-inside-a-retimed-instance-moves-it-by-frames-of-the-open-symbol + ;; `box` runs at double speed from 10, so six frames of main are twelve of box. + (let [c (-> (studio) + (update-in [:symbols :main :nodes] dissoc :tri) + (assoc-in [:symbols :main :nodes a-uuid :time :rate] 2) + (assoc-in [:symbols :box :nodes :inner :channels [:geom :pts]] + (ch/keyed {4 [5 10 15 10 5 40] 20 [5 10 45 10 5 40]}))) + {slid :clip :as r} (nest/slide c :main [a-uuid :inner] 6) + fs [13 15 18 20]] + (is (nil? (:refused r)) (:refused r)) + (is (= {:mode :map :at 12 :rate 1} (get-in slid [:symbols :box :nodes :inner :time]))) + (is (= [4 60] (get-in slid [:symbols :box :nodes :inner :span])) "its span and keys are its own") + (is (= (picture c :main fs) (picture slid :main (map #(+ 6 %) fs))) + "what it did at a frame of main it now does six frames later") + (is (seq (first (picture c :main [14])))) + (is (empty? (first (picture slid :main [14]))) "and it is not there yet where it was") + (testing "sliding it again adds to where it is" + (is (= 2 (get-in (:clip (nest/slide slid :main [a-uuid :inner] -5)) + [:symbols :box :nodes :inner :time :at])))))) + +(deftest sliding-needs-nothing-on-screen-and-refuses-only-a-loop + (let [c (studio)] + (is (= 3 (get-in (:clip (nest/slide c :main [a-uuid :inner] 3)) + [:symbols :box :nodes :inner :time :at])) + "the instance starts at 10, and where the playhead is has nothing to do with it") + (is (:refused (nest/slide (assoc-in c [:symbols :main :nodes a-uuid :time :loop?] true) + :main [a-uuid :inner] 3)) + "but through a loop one frame outside is many inside"))) + +(deftest restacking-is-one-write-to-z + (let [shape (fn [z] {:kind :poly :z z :channels {}}) + c (-> (clip/blank) + (assoc-in [:symbols :main :nodes] {:a (shape "a1") :b (shape "a2") :c (shape "a3")})) + order (fn [c] (map key (sort-by (comp :z val) (get-in c [:symbols :main :nodes])))) + front (:clip (nest/restack c :main [:a] [:c] true)) + back (:clip (nest/restack c :main [:c] [:a] false)) + mid (:clip (nest/restack c :main [:a] [:b] true))] + (is (= [:b :c :a] (order front)) "in front of the front one") + (is (= [:c :a :b] (order back)) "behind the back one") + (is (= [:b :a :c] (order mid)) "between two") + (is (= (dissoc (get-in c [:symbols :main :nodes]) :a) + (dissoc (get-in mid [:symbols :main :nodes]) :a)) + "and nothing else is renumbered") + (is (:refused (nest/restack c :main [:a] [a-uuid :inner] true)) + "only among the things it is beside"))) diff --git a/frontend/test/arthur/domain/symbol_test.cljs b/frontend/test/arthur/domain/symbol_test.cljs index dae81e7..663ff09 100644 --- a/frontend/test/arthur/domain/symbol_test.cljs +++ b/frontend/test/arthur/domain/symbol_test.cljs @@ -107,6 +107,21 @@ (is (= [:a :b :c] (ids-at with 0))) (is (= (get-in base [:nodes :a]) (get-in with [:nodes :a])) "and :a is untouched"))) +(deftest z-between-always-finds-room + (let [between? (fn [a b z] (and (or (nil? a) (neg? (compare a z))) + (or (nil? b) (neg? (compare z b)))))] + (testing "on the keys scenes already have" + (doseq [[a b] [[nil "a1"] ["a1" nil] ["a1" "a2"] ["a1" "a3"] ["a" "a1"] + ["a1" "z1727000000000-shape"] [nil "0"] [nil "-"] ["c0000" "c0001"]]] + (is (between? a b (symbol/z-between a b)) (pr-str [a b (symbol/z-between a b)])))) + (testing "and again and again: to the back, to the front, and into one gap from either side" + (doseq [[label start step past?] [["back" "a1" #(symbol/z-between nil %) #(between? nil %1 %2)] + ["front" "a1" #(symbol/z-between % nil) #(between? %1 nil %2)] + ["under a2" "a1" #(symbol/z-between % "a2") #(between? %1 "a2" %2)] + ["over a1" "a2" #(symbol/z-between "a1" %) #(between? "a1" %1 %2)]]] + (is (every? (fn [[x y]] (past? x y)) (partition 2 1 (take 300 (iterate step start)))) + label))))) + ;; ---- transform composition through the tree ---- (deftest geometry-lands-in-the-parents-space diff --git a/static/arthur/app.css b/static/arthur/app.css index d6f7ee5..7bbd72a 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -660,9 +660,16 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } /* The preview row of a drop in flight: its own length, where it would start. */ .tl-span.ghost, .tl-label.ghost { pointer-events: none; } -/* A row being dragged over another: into an instance, or grouped with a node. */ +/* A row being dragged over another: into an instance, or grouped with a node, + by its middle; in front of it or behind it, by its top or bottom edge. */ .tl-label.drop-into { box-shadow: inset 0 0 0 2px var(--sel); background: var(--sel-bg); } -.tl-label.drop-group { box-shadow: inset 0 -2px 0 var(--sel); } +.tl-label.drop-group { outline: 2px dashed var(--sel); outline-offset: -2px; } +.tl-label.drop-front { box-shadow: inset 0 2px 0 var(--sel); } +.tl-label.drop-back { box-shadow: inset 0 -2px 0 var(--sel); } + +/* A node's bar slides it along its symbol's time. */ +.tl-span.movable { cursor: ew-resize; touch-action: none; } +.tl-span.movable.sliding { border-color: var(--sel); } .tl-span.ghost { background: transparent; border: 1px dashed var(--sel); @@ -678,6 +685,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } margin: -3.5px 0 0 -3.5px; background: var(--key); border-radius: 50%; + /* So grabbing a dot grabs the bar under it. */ + pointer-events: none; } .tl-playhead {