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

Slide rows along time and restack them, at any depth

Browse source 
A node's bar drags along the timeline: one write to its :at, for every node
alike, carried down through the instances above it. The stage and rows show
the slide live through ::render/clip, and it lands as one edit on release.

A row dropped on another's top or bottom edge goes in front of it or behind:
one write to :z, between its new neighbours (symbol/z-between). Onto the edge
of a row in another symbol, it moves there first. Neither needs anything on
screen — nest/down walks a row path by structure, without a frame.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-30 00:51:34 -04:00
parent 1b8bbc7372
commit 38850a29ba
8 changed files with 306 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

75
frontend/src/arthur/domain/nest.cljs
View file

@ -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

24
frontend/src/arthur/domain/symbol.cljs
View file

@ -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.

41
frontend/src/arthur/events/ui.cljs
View file

@ -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]]

17
frontend/src/arthur/subs/render.cljs
View file

@ -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

85
frontend/src/arthur/ui/timeline.cljs
View file

@ -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]
(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"))
[: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))) "%")}}]))
: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)}}])))])
^{: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)}}]]]])))

46
frontend/test/arthur/domain/nest_test.cljs
View file

@ -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")))

15
frontend/test/arthur/domain/symbol_test.cljs
View file

@ -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

13
static/arthur/app.css
View file

@ -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 {