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

A lane is a generic row of symbol clips

Browse source 
A lane was a drawing lane: the only thing that could go in one was a one-frame
held cel, and every other symbol instance stayed a permanent root row of its
own. Those are not two kinds of timing, they are one kind with two creation
policies. `lane/place-symbol` drops any library symbol in as a clip that plays
naturally at speed one, `lane/adopt` moves an instance that is already in the
document into a lane keeping its source, span, playback and corrections, and
`append-drawing`/`overwrite-drawing` keep being the policy that makes a new
empty symbol a one-frame hold. The child shape they produce is the same.

Both new commands claim their interval through `blank` before they write, so
the partition rule is unchanged and unduplicated: placing into occupied lane
time trims, removes or splits the incumbents, and a lane still never stores an
overlap. Real compositing overlap is another lane, where the order is explicit.

Creating a symbol with nothing aimed now makes a lane and a clip in it instead
of a loose root instance, and a pool drop prefers an explicitly targeted lane,
then the selected one, and makes a lane only when there is neither. That is
what stops the row-per-symbol growth coming back in through the drop path, and
it is why `add-lane` now takes a z in front of the existing root nodes and
calls what it makes a "lane" rather than "drawings".

The timeline learned the two gestures that a generic lane needs. A clip body
dragged over another lane's track previews there as a dashed block and lands
through `::adopt-in-lane`; the track is found with `elementsFromPoint` and its
selection read back off the element, because a pointer capture does not
retarget. A pool drop over an existing lane previews as a dashed clip inside
that lane instead of a temporary new row that appears and then vanishes --
which also needed the drag-leave check to be geometric, since inserting the
preview changes the element under the pointer and Chromium then reports a leave
with no related target. Lanes are renameable from their label, by double-click,
F2, or the pencil, through `::rename-node`.

`symbol/lane-cels` is `symbol/lane-clips`, and the vocabulary table in the
handoff now separates the two words it had merged: a clip is an instance in a
lane, and a cel is specifically the one-frame held source that drawing creation
makes. Keeping `cel` for the policy is what lets the lane stop being about
drawings at all.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-10-01 15:13:07 -04:00
parent 26ada03591
commit 5ebe776ce4
12 changed files with 590 additions and 174 deletions
Download patch file Download diff file Expand all files Collapse all files

103
frontend/src/arthur/domain/lane.cljs
View file

@ -1,11 +1,11 @@
(ns arthur.domain.lane
"The commands that need a SEQUENCE: make a lane, put drawings in it, change
how long they are exposed, empty part of it, and decide which cels share
content.
"The commands that need a SEQUENCE: make a lane, place symbol clips in it,
change how long they are exposed, empty part of it, and decide which held
drawing clips share content.
WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a
node map: a group with `:layout :sequence`, whose children are non-overlapping
visual cels. This namespace only changes them.
visual symbol clips. This namespace only changes them.
WHAT IS NOT HERE: split, trim and move. Each of those is one write to one
node's span or position, which is a fact every node has, so they live in
@ -56,7 +56,7 @@
:else
(let [[_ boundary] (node/placed-span n)
later (filter #(>= (first (node/placed-span %)) boundary)
(symbol/lane-cels nodes (:id lane)))
(symbol/lane-clips nodes (:id lane)))
nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta)))
nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
@ -76,7 +76,7 @@
n (get nodes id)
lane (get nodes (:parent n))
[lo old-out] (when n (node/placed-span n))
members (when (node/lane? lane) (symbol/lane-cels nodes (:id lane)))
members (when (node/lane? lane) (symbol/lane-clips nodes (:id lane)))
later (when members
(remove #(= id (:id %))
(filter #(>= (first (node/placed-span %)) old-out) members)))
@ -118,7 +118,7 @@
earlier (when (node/lane? lane)
(remove #(= id (:id %))
(filter #(<= (second (node/placed-span %)) old-in)
(symbol/lane-cels nodes (:id lane)))))
(symbol/lane-clips nodes (:id lane)))))
broken (first (symbol/lane-problems nodes))]
(cond
(not (node/lane? lane)) {:refused "select a cel in a lane"}
@ -178,7 +178,7 @@
[clip sid lane-id [a b] {:keys [id]}]
(let [nodes (get-in clip [:symbols sid :nodes])
lane (get nodes lane-id)
members (when (node/lane? lane) (symbol/lane-cels nodes lane-id))
members (when (node/lane? lane) (symbol/lane-clips nodes lane-id))
spanning (when members
(first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b)))
members)))]
@ -205,12 +205,81 @@
(span/finish clip sid nodes (or (when spanning id) lane-id) :keep)))))
(defn add-lane [clip sid id]
(if (or (nil? (clip/symbol clip sid)) (get-in clip [:symbols sid :nodes id]))
{:refused "the symbol is missing or the lane ID is already used"}
{:clip (assoc-in clip [:symbols sid :nodes id]
{:id id :name "drawings" :kind :group :layout :sequence
:z (str "z-" id)})
:selection id}))
(let [nodes (get-in clip [:symbols sid :nodes])
front (last (sort (keep (fn [[_ n]] (when (nil? (:parent n)) (:z n))) nodes)))]
(if (or (nil? (clip/symbol clip sid)) (get nodes id))
{:refused "the symbol is missing or the lane ID is already used"}
{:clip (assoc-in clip [:symbols sid :nodes id]
{:id id :name "lane" :kind :group :layout :sequence
:z (symbol/z-between front nil)})
:selection id})))
(defn place-symbol
"Place arbitrary symbol `source-id` as a naturally playing clip in a lane.
The new clip claims its interval: existing clips under that interval are
trimmed, removed, or split by `blank`, so the lane remains a partition rather
than storing an overlap. This is the generic operation behind dropping a
library symbol into a lane; one-frame held drawing creation remains a policy
of `append-drawing`/`overwrite-drawing`, not a different lane type."
[clip store sid lane-id id source-id at
{:keys [extent point remainder-id] :or {extent :keep}}]
(let [nodes (get-in clip [:symbols sid :nodes])
lane (get nodes lane-id)
seeded (clip/place-symbol clip store sid source-id 0 id point)
n (get-in seeded [:symbols sid :nodes id])
duration (when n (- (second (node/placed-span n))
(first (node/placed-span n))))]
(cond
(not (node/lane? lane)) {:refused "select a lane"}
(contains? nodes id) {:refused "the new clip ID is already used"}
(not (and (integer? at) (not (neg? at))))
{:refused "a position is a nonnegative whole lane frame"}
(nil? (clip/symbol clip source-id)) {:refused "there is no such symbol to place"}
(nil? n) {:refused "a symbol cannot go inside itself"}
(not (pos? duration)) {:refused "the symbol has no frames to place"}
(and remainder-id (contains? nodes remainder-id))
{:refused "the remainder clip needs a free ID"}
:else
(let [cleared (blank clip sid lane-id [at (+ at duration)]
{:id remainder-id})]
(if (:refused cleared)
cleared
(let [nodes (assoc (get-in (:clip cleared) [:symbols sid :nodes]) id
(-> n
(assoc :parent lane-id)
(assoc-in [:time :at] at)))]
(span/finish (:clip cleared) sid nodes id extent)))))))
(defn adopt
"Move an existing visual instance into `lane-id` at lane frame `at`.
Its source, span, transforms, corrections, and identity come with it; the
destination interval is claimed with the same overwrite trimming as a pool
drop."
[clip sid lane-id id at {:keys [extent remainder-id] :or {extent :keep}}]
(let [nodes (get-in clip [:symbols sid :nodes])
lane (get nodes lane-id)
n (get nodes id)
[lo hi] (when n (node/placed-span n))
duration (when (and lo hi) (- hi lo))]
(cond
(not (node/lane? lane)) {:refused "select a lane"}
(not= :instance (:kind n)) {:refused "only a symbol clip goes in a lane"}
(= lane-id (:parent n)) {:refused "this clip is already in that lane"}
(not (and (integer? at) (not (neg? at))))
{:refused "a position is a nonnegative whole lane frame"}
(not (pos? duration)) {:refused "the clip has no frames to place"}
(and remainder-id (contains? nodes remainder-id))
{:refused "the remainder clip needs a free ID"}
:else
(let [cleared (blank clip sid lane-id [at (+ at duration)] {:id remainder-id})]
(if (:refused cleared)
cleared
(let [moved (-> n
(assoc :parent lane-id)
(update-in [:time :at] (fnil + 0) (- at lo)))
nodes (assoc (get-in (:clip cleared) [:symbols sid :nodes]) id moved)]
(span/finish (:clip cleared) sid nodes id extent)))))))
;; ---------------------------------------------------------------------------
;; putting drawings in a lane
@ -239,7 +308,7 @@
"Where lane `lane-id`'s occupied frames stop, in its own time."
[nodes lane-id]
(apply max 0 (map #(second (node/placed-span %))
(symbol/lane-cels nodes lane-id))))
(symbol/lane-clips nodes lane-id))))
(defn- place
"Put a held cel of `drawing-id` into `lane-id` at lane frame `at`, and
@ -260,7 +329,7 @@
[lo hi] (node/placed-span n)
later (when ripple?
(filter #(>= (first (node/placed-span %)) lo)
(symbol/lane-cels nodes lane-id)))
(symbol/lane-clips nodes lane-id)))
nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo)))
(assoc nodes id n) later)
@ -280,7 +349,7 @@
inside (when (number? at)
(some (fn [n] (let [[lo hi] (node/placed-span n)]
(when (< lo at hi) n)))
(symbol/lane-cels nodes lane-id)))]
(symbol/lane-clips nodes lane-id)))]
(cond
(not (node/lane? lane)) "select a lane"
(contains? nodes id) "the new cel ID is already used"

4
frontend/src/arthur/domain/span.cljs
View file

@ -48,7 +48,7 @@
[clip sid nodes selection extent]
(let [sym (clip/symbol clip sid)
reach (for [[id n] nodes :when (node/lane? n)
child (symbol/lane-cels nodes id)
child (symbol/lane-clips nodes id)
:let [m (symbol/frame-map nodes id)
end (second (node/placed-span child))]]
(when m (+ (:at m) (/ end (:rate m)))))
@ -126,7 +126,7 @@
THE RIGHT PIECE KEEPS THE ORIGINAL'S `:z`. Two halves of one thing draw at
one depth; nothing orders them against each other, because they are never on
screen on the same frame. Cels in a lane do not consult `:z` at all —
`symbol/lane-cels` sorts them by where they start.
`symbol/lane-clips` sorts them by where they start.
The right piece is the selection, because it is the piece that was made."
[clip sid id cut new-id]

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

@ -90,8 +90,8 @@
[nodes id]
(dec (count (lineage nodes id))))
(defn lane-cels
"The cels of lane `lane`, in the order they are exposed.
(defn lane-clips
"The symbol clips of lane `lane`, in timeline order.
Sorted by where they START, not by `:z`: a lane's blocks follow one another in
time, and two of them cannot be in the same place for `:z` to decide between.
@ -147,7 +147,7 @@
the parent and stencil references, rather than wherever a command happens to
build one.
Cels must be visual, finite and non-overlapping. An accidental overlap
Clips must be visual, finite and non-overlapping. An accidental overlap
is refused rather than resolved by draw order: two drawings exposed on one
frame of one lane is a document nobody meant to write, and picking a winner
would hide it. Empty lanes are valid — a lane is made before it is filled."
@ -165,9 +165,9 @@
intervals (sort-by first (map node/placed-span (filter valid? children)))]
(concat
(for [n children :when (not (valid? n))]
(str "sequence " id " needs finite visual cels: " (:id n)))
(str "sequence " id " needs finite visual symbol clips: " (:id n)))
(when (some (fn [[[_ b] [c _]]] (> b c)) (partition 2 1 intervals))
[(str "lane " id " has overlapping cels")])))))
[(str "lane " id " has overlapping clips")])))))
nodes)))
(defn order

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

@ -18,7 +18,8 @@
All of it is `assoc-in` under `:ui`. There is no effect in this namespace and
there should not be one: an editor's own state is the cheapest thing in the
app to change and the most expensive to have two copies of."
(:require [arthur.domain.clip :as clip]
(:require [clojure.string :as str]
[arthur.domain.clip :as clip]
[arthur.domain.correction :as correction]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
@ -32,6 +33,17 @@
[arthur.footage.store :as store]
[re-frame.core :as rf]))
(rf/reg-event-db
::rename-node
(fn [db [_ sid id value]]
(let [document (:clip (store/entry (:clip/current db)))
value (not-empty (str/trim (str value)))]
(if-not (get-in document [:symbols sid :nodes id])
db
(edit/transaction db #(if value
(assoc-in % [:symbols sid :nodes id :name] value)
(update-in % [:symbols sid :nodes id] dissoc :name)))))))
(defn selected
"`db` with `selection` selected, and nothing aimed.
@ -431,14 +443,14 @@
db)))
(defn into-the-lane
"Where a polygon drawn in the CEL SHEET goes: the row path of the cel the
aimed lane exposes at the playhead, and the clip that cel is in. `{:clip
:path}`, or `{:refused why}`.
"Where a polygon drawn with a lane aimed goes: the path of the held clip the
lane exposes at the playhead, and the document containing it. `{:clip :path}`,
or `{:refused why}`.
A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The sheet is a drawing-lane mode
and the frame under the playhead is where the drawing belongs, so drawing on
an empty frame makes the drawing that was missing — which is the whole reason
there is no `new drawing` button any more: the gesture already says it.
A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The frame under the playhead is
where the drawing belongs, so drawing on an empty frame makes the one-frame
held clip that was missing. The gesture already says what the removed drawing
controls used to say.
`overwrite-drawing` rather than `append-drawing`, because a gap already has
the room. Appending RIPPLES everything after it later by the new cel's
@ -456,7 +468,7 @@
cel (when (integer? at)
(some (fn [c] (let [[lo hi] (node/placed-span c)]
(when (and (<= lo at) (< at hi)) c)))
(symbol/lane-cels (get-in clip [:symbols open :nodes]) lane-id)))]
(symbol/lane-clips (get-in clip [:symbols open :nodes]) lane-id)))]
(cond
(not (integer? at))
{:refused "the playhead is not on one frame of this lane"}
@ -471,7 +483,7 @@
(defn polygon-landing
"Choose the document and row path a finished polygon is drawn into.
An aimed drawing lane wins regardless of what is selected on the stage: an
An aimed lane wins regardless of what is selected on the stage: an
occupied frame lands in its cel and a gap first becomes a one-frame drawing.
With no lane aimed, ordinary target-based drawing is unchanged."
[clip st db]
@ -481,7 +493,7 @@
(defn beginning-polygon
"Enter polygon mode, first materializing a drawing at the playhead when a
drawing lane is aimed and that frame is empty.
lane is aimed and that frame is empty.
Creating here, rather than when the polygon is finished, means the drawing is
already the current cel while points are being placed. Cancelling the polygon
@ -567,24 +579,24 @@
(rf/reg-event-db
::new-symbol
;; `where` is `:inside` — in whatever the target names — or `:top`, in the open
;; symbol regardless of it. A drawing lane is the temporal form of this same
;; operation: inside it, a new symbol is a one-frame cel at the playhead.
;; symbol regardless of it. A lane is the temporal form of this same operation:
;; inside it, a new empty symbol is a one-frame held clip at the playhead.
(fn [db [_ where]]
(let [{clip :clip st :store} (store/entry (:clip/current db))
drawing-lane (when (= :inside where) (aimed-lane clip db))
target-lane (when (= :inside where) (aimed-lane clip db))
open (get-in db [:ui :open])
owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame])))
at (when (and drawing-lane (number? owner))
(lane/lane-frame clip open (:id drawing-lane) owner))
at (when (and target-lane (number? owner))
(lane/lane-frame clip open (:id target-lane) owner))
drawing-id (clip/fresh-id clip)
cel-id (random-uuid)
down (if (= :top where) [] (where-new-goes clip db))
{host :sid frame :frame} (nest/inside clip st open down
(get-in db [:playback :frame]))
uuid (random-uuid)]
(if drawing-lane
lane-id (random-uuid)]
(if target-lane
(let [result (if (integer? at)
(lane/overwrite-drawing clip open (:id drawing-lane) cel-id drawing-id at
(lane/overwrite-drawing clip open (:id target-lane) cel-id drawing-id at
{:extent :grow-symbol
:remainder-id (random-uuid)})
{:refused "the playhead is not on one frame of this lane"})]
@ -594,19 +606,23 @@
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node open cel-id [cel-id]]))))
(if-not host
(update db :project merge
{:status "what you are adding to is not on screen at this frame"})
(let [made [:node host uuid (conj down uuid)]]
(-> db
(edit/transaction #(clip/new-symbol % host drawing-id frame uuid))
;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the
;; next thing made goes in it; the outline says so before anybody
;; has to find out by drawing.
(aimed made)
;; Open every row down to it, or the new row is inside a closed one
;; and the button looks like it did nothing.
(update-in [:ui :expanded] (fnil into #{})
(rest (reductions conj [] down))))))))))
(update db :project merge
{:status "what you are adding to is not on screen at this frame"})
(let [prepared (lane/add-lane clip host lane-id)
result (if (:refused prepared) prepared
(lane/overwrite-drawing (:clip prepared) host lane-id
cel-id drawing-id frame
{:extent :grow-symbol
:remainder-id (random-uuid)}))]
(if-let [why (:refused result)]
(update db :project merge {:status why})
(-> db
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node host cel-id (conj down cel-id)])
(assoc-in [:ui :target]
{:sid host :id lane-id :path (conj down lane-id)})
(update-in [:ui :expanded] (fnil into #{})
(rest (reductions conj [] down)))))))))))
;; ---------------------------------------------------------------------------
;; a drop in flight
@ -629,15 +645,42 @@
(rf/reg-event-db
::drop-symbol
;; `point` is the stage pixel it was dropped on, or nil from the timeline.
(fn [db [_ sid frame point]]
(let [uuid (random-uuid)
host (get-in db [:ui :open])]
(-> db
(update :ui dissoc :drop)
(edit/edit-entry #(update % :clip clip/place-symbol (:store %)
host sid (* frame (:rate (clip/grid-time (:clip %) host))) uuid point))
(assoc-in [:ui :selection] [:node host uuid [uuid]])))))
;; A symbol dropped on a lane becomes a naturally playing clip in that lane.
;; With no lane under it, make one: new timeline/stage placement therefore
;; never invents another permanent row-per-symbol track.
(fn [db [_ source-id frame point target]]
(let [{document :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
selected (get-in db [:ui :selection])
[_ selected-sid selected-id] selected
selected-node (get-in document [:symbols selected-sid :nodes selected-id])
target (or target (when (node/lane? selected-node) selected))
[_ target-sid target-id target-path] target
target-node (get-in document [:symbols target-sid :nodes target-id])
existing? (and (= :node (first target)) (node/lane? target-node))
lane-id (if existing? target-id (random-uuid))
sid (if existing? target-sid open)
prepared (if existing? {:clip document}
(lane/add-lane document sid lane-id))
lane-selection [:node sid lane-id (if existing? target-path [lane-id])]
owner-frame (selection-frame (:clip prepared) st open lane-selection frame)
at (when (number? owner-frame)
(lane/lane-frame (:clip prepared) sid lane-id owner-frame))
uuid (random-uuid)
result (if (integer? at)
(lane/place-symbol (:clip prepared) st sid lane-id uuid source-id at
{:extent :grow-symbol :point point
:remainder-id (random-uuid)})
{:refused "the drop is not on one frame of this lane"})
path (conj (vec (butlast (nth lane-selection 3))) uuid)]
(if-let [why (or (:refused prepared) (:refused result))]
(-> db (update :ui dissoc :drop) (update :project merge {:status why}))
(cond-> (-> db
(update :ui dissoc :drop)
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node sid uuid path]))
(not existing?)
(assoc-in [:ui :target] {:sid sid :id lane-id :path [lane-id]}))))))
(rf/reg-event-db
::drop-sound
@ -649,6 +692,29 @@
(edit/edit #(clip/place-sound % host source label length rate (* frame (:rate (clip/grid-time % host))) uuid))
(assoc-in [:ui :selection] [:node host uuid [uuid]])))))
(rf/reg-event-db
::adopt-in-lane
(fn [db [_ [_ from-sid id _] [_ lane-sid lane-id lane-path :as lane-selection]
frame]]
(let [{document :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
owner-frame (selection-frame document st open lane-selection frame)
at (when (number? owner-frame)
(lane/lane-frame document lane-sid lane-id owner-frame))
result (cond
(not= from-sid lane-sid)
{:refused "a clip and its destination lane must be in the same symbol"}
(not (integer? at)) {:refused "the drop is not on one frame of this lane"}
:else (lane/adopt document lane-sid lane-id id at
{:extent :grow-symbol
:remainder-id (random-uuid)}))
path (conj (vec (butlast lane-path)) id)]
(if-let [why (:refused result)]
(update db :project merge {:status why})
(-> db
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node lane-sid id path]))))))
;; ---------------------------------------------------------------------------
;; moving rows between symbols
;;

21
frontend/src/arthur/ui/drag.cljs
View file

@ -57,8 +57,9 @@
(defn row!
"Start carrying the timeline row at `path` — a node of kind `node-kind`, to be
moved into another symbol or grouped with another node."
[path node-kind]
(reset! carrying {:kind :row :path path :node-kind node-kind}))
[path node-kind selection]
(reset! carrying {:kind :row :path path :node-kind node-kind
:selection selection}))
(defn row
"The path of the row being carried, or nil when it is not a row."
@ -70,6 +71,9 @@
[]
(:node-kind @carrying))
(defn row-selection []
(when (= :row (:kind @carrying)) (:selection @carrying)))
(defn other!
"Start carrying something that is not yet in the document: `:kind` says what,
and the rest is what a preview can show of it before it is fetched."
@ -85,11 +89,13 @@
(defn hover!
"Say where the drag would land, for the previews. `point` is nil over the
timeline."
[where frame point]
([where frame point] (hover! where frame point nil))
([where frame point target]
(when-let [{:keys [kind label frames]} @carrying]
(rf/dispatch [::ui/drop-hover {:where where :frame frame :point point
:label label :frames frames
:sound? (= :sound kind)}])))
:target target
:sound? (= :sound kind)}]))))
(defn pos-for
"Where the preview goes so the symbol's middle is under `point` — what
@ -100,10 +106,11 @@
(defn land!
"Drop what is being carried at `frame` of the open symbol: with its middle on
stage pixel `point`, or, with no point — the timeline — where it was drawn."
[frame point]
([frame point] (land! frame point nil))
([frame point target]
(when-let [{:keys [kind sid] :as c} (when (accepts?) @carrying)]
(case kind
:symbol (rf/dispatch [::ui/drop-symbol sid frame point])
:symbol (rf/dispatch [::ui/drop-symbol sid frame point target])
;; Video is asked about before anything happens: which frames, and what
;; the symbol they become is called.
:footage (rf/dispatch [::footage/ask-convert c frame point])
@ -111,4 +118,4 @@
;; Where it is dropped in time; a sound has no place in space.
:sound (rf/dispatch [::ui/drop-sound c frame])
nil))
(done!))
(done!)))

2
frontend/src/arthur/ui/location.cljs
View file

@ -199,5 +199,5 @@
", ignoring what is aimed")
:on-click #(rf/dispatch [::ui/new-symbol :top])}
{:label "lane"
:sub (str "a row of drawings in " (clip/symbol-name clip open))
:sub (str "a row for symbol clips in " (clip/symbol-name clip open))
:on-click #(rf/dispatch [::ui/new-lane])}]}]]))

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

@ -135,6 +135,7 @@
:label (node-label id n)
:kind :node
:node-kind (:kind n)
:lane? (node/lane? n)
:of (node/source n)
:select [:node sid id rpath]
:expandable? true
@ -145,12 +146,11 @@
(distinct))
(vals channels))
:dense? (boolean (some :dense (vals channels)))}]
;; AN CEL IS NOT A ROW. A lane's drawings are cel
;; blocks on the lane's own row, so a lane of twelve
;; cels is one row and not twelve — which is the
;; vertical growth that made a keyed source look
;; necessary. The cel is still the thing selected
;; and addressed; only its presentation is shared.
;; A CLIP IS NOT A ROW. A lane's symbol clips are
;; blocks on the lane's own row, so twelve clips are
;; still one row. The clip remains independently
;; selectable and addressable; only its presentation
;; is shared.
(if (node/lane? (get-in sym [:nodes (:parent n)]))
[]
(let [row (cond-> row
@ -163,7 +163,7 @@
:source (node/source child)
:span (mapv self (node/placed-span child))
:select [:node sid (:id child) (conj path (:id child))]})
(symbol/lane-cels (:nodes sym) id))))]
(symbol/lane-clips (:nodes sym) id))))]
(if-not open?
[row]
(-> [row]
@ -221,6 +221,20 @@
x (- (.-clientX event) (.-left box))]
(-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames)))))
(defn- frame-at-element [^js event frames ^js element]
(let [box (.getBoundingClientRect element)
x (- (.-clientX event) (.-left box))]
(-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames)))))
(defn- lane-under
"The lane track geometrically under a captured pointer, and its selection."
[^js event]
(some (fn [^js el]
(when-let [track (.closest el ".tl-track")]
(when-let [selection (aget track "arthurLane")]
[track selection])))
(array-seq (.elementsFromPoint js/document (.-clientX event) (.-clientY event)))))
;; ---------------------------------------------------------------------------
;; the panes
@ -296,8 +310,8 @@
(doall (for [[r label] [[0.25 "¼×"] [0.5 "½×"] [1.0 "1×"] [2.0 "2×"] [4.0 "4×"]]]
^{:key r} [:option {:value r} label]))]]
[:span.sep]
;; The same direct timing operations apply to any selected span, whether it
;; is at the root or is a cel inside a drawing lane.
;; The same direct timing operations apply to any selected symbol clip,
;; whether it is still a legacy root node or lives in a lane.
[:div.group.timing-controls {:aria-label "timing"}
[:button {:disabled (not cuttable?) :aria-label "split"
:title "split the selected clip at the playhead"
@ -352,14 +366,21 @@
on every render after, which would fight a person scrolling away."
(memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"}))))))
(defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of via]}
selection target over solo tracing]
(defn- label-cell [{:keys [path depth label kind node-kind lane? select expandable? expanded? of via]}
selection target over solo tracing renaming draft]
(let [node? (= :node kind)
;; AIMED IS NOT SELECTED, so it does not wear the selected class. The
;; target is where a new thing would go; the selection is what the
;; inspector is showing. One row is often both and must still say which
;; of the two it is being.
aimed? (and node? (= path (:path target)))
editing? (and lane? (= select @renaming))
begin-rename! (fn [] (reset! draft label) (reset! renaming select))
commit-rename! (fn []
(when (= select @renaming)
(reset! renaming nil)
(let [[_ sid id] select]
(rf/dispatch [::ui/rename-node sid id @draft]))))
[over-path where] @over]
[:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on")
(when aimed? " aimed")
@ -371,6 +392,7 @@
(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;
@ -379,7 +401,14 @@
;; the first moves where new drawings and symbols go.
:on-click #(when select (rf/dispatch [::ui/aim select]))
;; An instance's row opens the symbol it places, as a tab.
:on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))}
: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!))))}
;; 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
@ -390,7 +419,7 @@
(.stopPropagation e)
(.setData (.-dataTransfer e) "text/plain" "row")
(set! (.. e -dataTransfer -effectAllowed) "move")
(drag/row! path node-kind))
(drag/row! path node-kind select))
:on-drag-end (fn [_] (reset! over nil) (drag/done!))
:on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e)))
:on-drag-over (fn [^js e]
@ -419,8 +448,25 @@
(.stopPropagation e)
(rf/dispatch [::ui/toggle-row path]))}
(when expandable? (if expanded? "▾" "▸"))]
[:span.name label]
(if editing?
[:input.tl-name-input
{:value @draft :auto-focus true :aria-label "lane name"
:on-click #(.stopPropagation %)
:on-double-click #(.stopPropagation %)
:on-change #(reset! draft (.. % -target -value))
:on-blur commit-rename!
:on-key-down (fn [^js e]
(case (.-key e)
"Enter" (do (.preventDefault e) (commit-rename!))
"Escape" (do (.preventDefault e) (reset! renaming nil))
nil))}]
[:span.name label])
(when node? [:span.kind (if via (str "· in " via) (str "·" (name node-kind)))])
(when lane?
[:button.tl-rename
{:title "rename lane (F2)"
:on-click (fn [^js e] (.stopPropagation e) (begin-rename!))}
"✎"])
;; A face's row is where its own footage is switched on, next to solo
;; because the two are the same kind of thing: what this row shows, here,
;; now, and nothing the picture keeps. The inspector's footage section does
@ -450,29 +496,51 @@
"`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 node-kind select slides cels]} frames sliding]
[{:keys [path span keys dense? kind node-kind select slides cels lane?]} frames sliding]
(let [active-row (:row @sliding)
slide (fn [^js e]
(let [{from :row x0 :x width :width} @sliding]
(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 @sliding) df
(:kind @sliding) (:ripple? @sliding)
(:other @sliding)]))))))
(when (= path from)
(let [df (js/Math.round (/ (* frames (- (.-clientX e) x0)) (max 1 width)))
drag (:drag @sliding)
[target-el target] (when drag (lane-under e))
crossing? (and target (not= target (:source-lane drag)))
target-frame (when crossing?
(max 0 (- (frame-at-element e frames target-el)
(:grab drag))))]
(if crossing?
(do
(swap! sliding assoc :target-lane target :target-frame target-frame)
(rf/dispatch [::ui/sliding nil]))
(do
(swap! sliding dissoc :target-lane :target-frame)
(when (not= df (:df @sliding))
(swap! sliding assoc :df df)
(rf/dispatch [::ui/sliding (:path @sliding) df
(:kind @sliding) (:ripple? @sliding)
(:other @sliding)]))))))))
done (fn [commit?]
(when (= path (:row @sliding))
(let [{:keys [path df kind ripple? other]} @sliding]
(let [{:keys [path df kind ripple? other target-lane target-frame drag]} @sliding]
(reset! sliding nil)
(rf/dispatch (if commit? [::ui/slide path df kind ripple? other]
[::ui/sliding nil])))))
begin! (fn [^js e actual-path gesture-kind actual-select other]
(cond
(and commit? target-lane drag)
(do (rf/dispatch [::ui/sliding nil])
(rf/dispatch [::ui/adopt-in-lane (:selection drag)
target-lane target-frame]))
commit? (rf/dispatch [::ui/slide path df kind ripple? other])
:else (rf/dispatch [::ui/sliding nil])))))
begin! (fn [^js e actual-path gesture-kind actual-select other drag]
(let [track (.closest (.-currentTarget e) ".tl-track")]
(.stopPropagation e)
(when actual-select (rf/dispatch [::ui/select actual-select]))
(reset! sliding {:row path :path actual-path :kind gesture-kind
:other other
:drag (when drag
(assoc drag
:source-lane select
:grab (- (frame-at-element e frames track)
(:in drag))))
:ripple? (and (= :out gesture-kind) (.-shiftKey e))
:x (.-clientX e) :df 0
:width (.-width (.getBoundingClientRect track))})
@ -483,7 +551,31 @@
;; 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))}
:on-pointer-cancel (fn [_] (done false))
:ref (when lane? (fn [el] (when el (aset el "arthurLane" select))))
:on-drag-enter (fn [^js e]
(when (and lane? (or (drag/accepts?) (drag/row)))
(.preventDefault e)
(.stopPropagation e)
(when (drag/accepts?)
(drag/hover! :timeline (frame-at e frames) nil select))))
:on-drag-over (fn [^js e]
(when (and lane? (or (drag/accepts?) (drag/row)))
(.preventDefault e)
(.stopPropagation e)
(set! (.. e -dataTransfer -dropEffect)
(if (drag/row) "move" "copy"))
(when (drag/accepts?)
(drag/hover! :timeline (frame-at e frames) nil select))))
:on-drop (fn [^js e]
(when (and lane? (or (drag/accepts?) (drag/row)))
(.preventDefault e)
(.stopPropagation e)
(if-let [from (drag/row-selection)]
(do (drag/done!)
(rf/dispatch [::ui/adopt-in-lane from select
(frame-at e frames)]))
(drag/land! (frame-at e frames) nil select))))}
;; 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 (and span (nil? cels)) [(max 0 (first span)) (min frames (second span))])]
@ -495,46 +587,62 @@
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
:on-pointer-down
(when select
#(begin! % (or slides path) :slide select nil))}
#(begin! % (or slides path) :slide select nil nil))}
(when select
[:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips"
:on-pointer-down #(begin! % path :out select nil)}])]))
:on-pointer-down #(begin! % path :out select nil nil)}])]))
(doall
(for [[i {:keys [id label source span select]}] (map-indexed vector cels)
(for [[i {:keys [id label source span select ghost?]}]
(map-indexed vector
(cond-> (vec cels)
(= select (:target-lane @sliding))
(conj {:id ::moving :label (get-in @sliding [:drag :label])
:span [(:target-frame @sliding)
(+ (:target-frame @sliding)
(get-in @sliding [:drag :duration]))]
:ghost? true})))
:let [prev (when (pos? i) (nth cels (dec i)))
joined? (and prev (= (second (:span prev)) (first span)))
joined? (and (not ghost?) prev (= (second (:span prev)) (first span)))
in (max 0 (first span)) out (min frames (second span))]
:when (< in out)]
^{:key (str id)}
[:button.tl-cel
{:title (str label " · select cel; double-click to edit shared drawing")
{:title (str label " · select clip; double-click to edit its symbol")
:class (when ghost? "ghost")
:style {:position "absolute" :left (edge% in frames)
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")
:top "2px" :bottom "2px" :overflow "visible" :padding "0 3px"}
:on-pointer-down #(begin! % (nth select 3) :slide select nil)
:on-click (fn [e] (.stopPropagation e)
(rf/dispatch [::ui/select select])
(rf/dispatch [::pb/seek (js/Math.floor in)]))
:on-double-click (fn [e] (.stopPropagation e)
(when source (rf/dispatch [::pb/open-symbol source])))}
:on-pointer-down (when select
#(begin! % (nth select 3) :slide select nil
{:selection select :label label :in in
:duration (- out in)}))
:on-click (when select
(fn [e] (.stopPropagation e)
(rf/dispatch [::ui/select select])
(rf/dispatch [::pb/seek (js/Math.floor in)])))
:on-double-click (when select
(fn [e] (.stopPropagation e)
(when source (rf/dispatch [::pb/open-symbol source]))))}
[:span.tl-cel-label label]
(if joined?
[:span.tl-junction
{:title "Left: trim left · center: roll cut · right: trim right"
:on-pointer-down
(fn [^js e]
(let [box (.getBoundingClientRect (.-currentTarget e))
x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box)))
left-path (nth (:select prev) 3)
right-path (nth select 3)]
(cond
(< x 0.34) (begin! e left-path :out (:select prev) nil)
(> x 0.66) (begin! e right-path :in select nil)
:else (begin! e right-path :roll select left-path))))}]
[:span.tl-edge.in {:title "Drag start"
:on-pointer-down #(begin! % (nth select 3) :in select nil)}])
[:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips"
:on-pointer-down #(begin! % (nth select 3) :out select nil)}]]))
(when select
(if joined?
[:span.tl-junction
{:title "Left: trim left · center: roll cut · right: trim right"
:on-pointer-down
(fn [^js e]
(let [box (.getBoundingClientRect (.-currentTarget e))
x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box)))
left-path (nth (:select prev) 3)
right-path (nth select 3)]
(cond
(< x 0.34) (begin! e left-path :out (:select prev) nil nil)
(> x 0.66) (begin! e right-path :in select nil nil)
:else (begin! e right-path :roll select left-path nil))))}]
[:span.tl-edge.in {:title "Drag start"
:on-pointer-down #(begin! % (nth select 3) :in select nil nil)}]))
(when select
[:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips"
:on-pointer-down #(begin! % (nth select 3) :out select nil 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?
@ -547,7 +655,9 @@
;; The row a carried row is over and which part of it, for the
;; highlight.
over (r/atom nil)
sliding (r/atom nil)]
sliding (r/atom nil)
renaming (r/atom nil)
draft (r/atom "")]
(let [clip @(rf/subscribe [::render/clip])
frames (max 1 (or @(rf/subscribe [::render/frames]) 1))
frame @(rf/subscribe [::playback/frame])
@ -565,12 +675,21 @@
;; Where a drag out of the pool would land, as a row of its own at the
;; top of its section: its own length, starting on the frame it would
;; start on. The stage's drop shows it too, at the playhead.
ghost (when drop
drop-lane (:target drop)
ghost (when (and drop (nil? drop-lane))
{:path [::drop] :depth 0 :kind :ghost
:label (str "+ " (:label drop))
:span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]
:keys []})
picture (cond->> (rows clip open expanded)
lane-ghost (when (and drop drop-lane (not (:sound? drop)))
{:id ::drop :label (str "+ " (:label drop)) :ghost? true
:span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]})
picture (cond->> (cond->> (rows clip open expanded)
lane-ghost
(mapv (fn [row]
(if (= drop-lane (:select row))
(update row :cels (fnil conj []) lane-ghost)
row))))
(and ghost (not (:sound? drop))) (cons ghost))
sounds (cond->> (sound-rows clip open expanded)
(and ghost (:sound? drop)) (cons ghost))
@ -601,7 +720,7 @@
(doall (for [row visible]
(with-meta (if (= :section (:kind row))
[:div.tl-label.tl-section (:label row)]
[label-cell row selection target over solo tracing])
[label-cell row selection target over solo tracing renaming draft])
{:key (str (:path row))})))]
[:div.tl-tracks
{:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
@ -610,8 +729,17 @@
(.preventDefault e)
(drag/hover! :timeline (frame-at e frames) nil)))
:on-drag-leave (fn [^js e]
(when-not (.contains (.-currentTarget e) (.-relatedTarget e))
(rf/dispatch [::ui/drop-clear])))
(let [box (.getBoundingClientRect (.-currentTarget e))
inside? (and (<= (.-left box) (.-clientX e) (.-right box))
(<= (.-top box) (.-clientY e) (.-bottom box)))]
;; Adding the inline ghost changes the element below
;; the pointer and Chromium reports a leave with no
;; related target. Keep the preview while the pointer
;; is still geometrically inside the tracks.
(when (and (not inside?)
(not (.contains (.-currentTarget e)
(.-relatedTarget e))))
(rf/dispatch [::ui/drop-clear]))))
;; In its own coordinates: dropped in time, nowhere in particular in
;; space, so what was drawn at a place stays at that place.
:on-drop (fn [^js e]

49
frontend/test/arthur/domain/lane_test.cljs
View file

@ -102,16 +102,16 @@
:extent :grow-symbol}))
shrink (:clip (lane/resize-out doc :main :a 2 {:ripple? true}))]
(is (= [[0 6] [6 8] [8 12]]
(mapv node/placed-span (symbol/lane-cels (get-in plain [:symbols :main :nodes]) :girl)))
(mapv node/placed-span (symbol/lane-clips (get-in plain [:symbols :main :nodes]) :girl)))
"a normal grow eats the beginning of the adjacent cel")
(is (= [[0 9] [9 12]]
(mapv node/placed-span (symbol/lane-cels (get-in across [:symbols :main :nodes]) :girl)))
(mapv node/placed-span (symbol/lane-clips (get-in across [:symbols :main :nodes]) :girl)))
"a long grow removes wholly consumed cels and trims the survivor")
(is (= [[0 6] [6 10] [10 14]]
(mapv node/placed-span (symbol/lane-cels (get-in ripple [:symbols :main :nodes]) :girl)))
(mapv node/placed-span (symbol/lane-clips (get-in ripple [:symbols :main :nodes]) :girl)))
"shift-grow moves every later cel")
(is (= [[0 2] [2 6] [6 10]]
(mapv node/placed-span (symbol/lane-cels (get-in shrink [:symbols :main :nodes]) :girl)))
(mapv node/placed-span (symbol/lane-clips (get-in shrink [:symbols :main :nodes]) :girl)))
"shift-shrink pulls every later cel left")
(is (:refused (lane/resize-out doc :main :a 0 {})))
(is (:refused (lane/resize-out doc :main :a 2.5 {})))))
@ -122,13 +122,13 @@
right-only (:clip (lane/resize-in doc :main :b 6))
grown-left (:clip (lane/resize-in doc :main :b 2))]
(is (= [[0 6] [6 8] [8 12]]
(mapv node/placed-span (symbol/lane-cels (get-in rolled [:symbols :main :nodes]) :girl)))
(mapv node/placed-span (symbol/lane-clips (get-in rolled [:symbols :main :nodes]) :girl)))
"the shared cut moves without moving either clip")
(is (= [[0 4] [6 8] [8 12]]
(mapv node/placed-span (symbol/lane-cels (get-in right-only [:symbols :main :nodes]) :girl)))
(mapv node/placed-span (symbol/lane-clips (get-in right-only [:symbols :main :nodes]) :girl)))
"the right side of the junction trims only the right clip")
(is (= [[0 2] [2 8] [8 12]]
(mapv node/placed-span (symbol/lane-cels (get-in grown-left [:symbols :main :nodes]) :girl)))
(mapv node/placed-span (symbol/lane-clips (get-in grown-left [:symbols :main :nodes]) :girl)))
"growing the right clip left trims the neighbour instead of overlapping")
(is (:refused (lane/roll doc :main :a :b 0)))
(is (:refused (lane/roll doc :main :a :insert 6)))))
@ -223,6 +223,39 @@
(is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed])))
(is (:refused (lane/append-drawing b :main :girl :a :new {})))))
(deftest arbitrary-symbols-drop-into-the-same-lane-and-claim-their-time
(let [doc (document)
dropped (lane/place-symbol doc nil :main :girl :clip :wave 2
{:extent :grow-symbol :remainder-id :tail})
after (:clip dropped)
clips (symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl)]
(is (= :clip (:selection dropped)))
(is (= [[0 2] [2 12]] (mapv node/placed-span clips))
"the natural ten-frame symbol claims [2,12), trimming/removing incumbents")
(is (= :wave (node/source (second clips))))
(is (= 1 (:speed (node/playback-of (second clips))))
"a dropped symbol plays; it is not converted into a drawing hold")
(is (empty? (clip/problems after)))))
(deftest an-existing-symbol-row-can-be-adopted-by-a-lane
(let [doc (assoc-in (document) [:symbols :main :nodes :badge]
{:id :badge :kind :instance :z "z"
:source {:symbol :wave} :span [0 3]
:time {:at 1 :rate 1}
:playback {:in 2 :speed 1 :end :stop}})
result (lane/adopt doc :main :girl :badge 5
{:extent :grow-symbol :remainder-id :tail})
after (:clip result)
n (get-in after [:symbols :main :nodes :badge])]
(is (= :girl (:parent n)))
(is (= [5 8] (node/placed-span n)))
(is (= {:in 2 :speed 1 :end :stop} (:playback n))
"adoption changes placement, not source timing")
(is (= [[0 4] [4 5] [5 8] [8 12]]
(mapv node/placed-span
(symbol/lane-clips (get-in after [:symbols :main :nodes]) :girl))))
(is (empty? (clip/problems after)))))
(deftest fractional-placement-rates-convert-the-hold-delta
(let [doc (-> (document)
(assoc-in [:symbols :main :nodes :a :time :rate] 2)
@ -557,7 +590,7 @@
;; drawing must not quietly shorten the film.
(let [doc (document)
empty-lane (:clip (lane/blank doc :main :girl [0 12] {}))]
(is (empty? (symbol/lane-cels (get-in empty-lane [:symbols :main :nodes]) :girl)))
(is (empty? (symbol/lane-clips (get-in empty-lane [:symbols :main :nodes]) :girl)))
(is (= 12 (get-in empty-lane [:symbols :main :frames])))
(is (empty? (clip/problems empty-lane)))
;; Growing is still the caller's word, and only ever grows.

102
frontend/test/browser/lane.mjs
View file

@ -160,13 +160,74 @@ try {
});
await sleep(250);
};
const dropPoolSymbol = async frame => {
const points = await evaluate(`(() => {
const source = document.querySelector('.pool-row:not(.main) .pool-item[draggable="true"]');
const track = document.querySelector('.tl-track');
if (!source || !track) return null;
source.scrollIntoView({block: 'center'});
const a = source.getBoundingClientRect(), b = track.getBoundingClientRect();
const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]);
return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * (${frame} + 0.25) / frames,
ty: b.top + b.height / 2};
})()`);
assert(points, 'a library symbol and lane are available to drag');
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx, y: points.sy});
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy,
button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.sx + 12, y: points.sy,
button: 'left', buttons: 1});
await sleep(120);
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty,
button: 'left', buttons: 1});
await sleep(120);
assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0,
'targeting an existing lane does not preview a temporary new row');
const lanePreview = await evaluate(`(() => {
const db = cljs.core.deref(re_frame.db.app_db), k = cljs.core.keyword;
return {ghosts: document.querySelectorAll('.tl-track .tl-cel.ghost').length,
drop: cljs.core.clj__GT_js(cljs.core.get_in(db, [k('ui'), k('drop')]))};
})()`);
assert.equal(lanePreview.ghosts, 1,
`the pool drop preview is drawn inside the targeted lane: ${JSON.stringify(lanePreview)}`);
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty,
button: 'left', buttons: 0, clickCount: 1});
await sleep(300);
};
const dragClipBetweenLanes = async frame => {
const points = await evaluate(`(() => {
const tracks = [...document.querySelectorAll('.tl-track')];
const source = tracks[1]?.querySelector('.tl-cel');
const target = tracks[0];
if (!source || !target) return null;
const a = source.getBoundingClientRect(), b = target.getBoundingClientRect();
const frames = Number(document.querySelector('.at-frame').textContent.split('/')[1]);
return {sx: a.left + a.width / 2, sy: a.top + a.height / 2,
tx: b.left + b.width * (${frame} + 0.25) / frames,
ty: b.top + b.height / 2};
})()`);
assert(points, 'two lanes and a source clip are available');
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: points.sx, y: points.sy,
button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: points.tx, y: points.ty,
button: 'left', buttons: 1});
await sleep(150);
assert.equal(await evaluate('document.querySelectorAll(".tl-track")[0].querySelectorAll(".tl-cel.ghost").length'), 1,
'cross-lane movement previews in the destination lane');
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: points.tx, y: points.ty,
button: 'left', buttons: 0, clickCount: 1});
await sleep(300);
};
await click('lane');
assert.equal(await evaluate('[...document.querySelectorAll(".timing-controls > button")].every(b => b.disabled)'), true,
'timing buttons are disabled when the selected row is a lane, not a symbol clip');
'timing buttons are disabled without a symbol clip');
await click('inside');
let s = await shot();
assert.deepEqual(placed(s), [[0, 1]], 'new inside an aimed lane is a one-frame symbol');
assert.deepEqual(placed(s), [[0, 1]],
'new at the root automatically makes a lane and a one-frame symbol clip');
assert.equal(await evaluate('document.querySelectorAll(".tl-label .kind").length'), 1,
'new temporal content creates a lane row rather than a row per symbol');
assert.equal(await evaluate(`document.querySelectorAll('.cel-sheet, [aria-label="time view"]').length`), 0,
'there is one temporal interface');
assert.equal(await evaluate('document.querySelectorAll(".timing-controls > button").length'), 3,
@ -207,8 +268,41 @@ try {
await drag('.tl-cel:first-of-type .tl-edge.out', 2);
assert.deepEqual(placed(await shot()), [[0, 6], [6, 7], [7, 8]],
'ordinary growth trims adjacent spans and never overlaps');
await dropPoolSymbol(10);
s = await shot();
assert.deepEqual(placed(s), [[0, 6], [6, 7], [7, 8], [10, 11]],
'an arbitrary library symbol drops into an existing lane');
assert.equal(instances(s).at(-1).playback.speed, 1,
'a dropped symbol plays naturally instead of becoming a held drawing');
await evaluate(`re_frame.core.dispatch(cljs.core.vector(cljs.core.keyword('arthur.events.ui/new-lane')))`);
await sleep(180);
s = await shot();
const renameControls = await evaluate('document.querySelectorAll(".tl-label .tl-rename").length');
assert.equal(renameControls, 2,
`both lanes expose rename controls: ${JSON.stringify(s.clip.symbols.main.nodes)}`);
await evaluate('document.querySelector(".tl-label .tl-rename").click()');
await sleep(80);
assert(await evaluate(`(() => {
const input = document.querySelector('.tl-name-input');
if (!input) return false;
Object.getOwnPropertyDescriptor(HTMLInputElement.prototype, 'value').set.call(input, 'Foreground');
input.dispatchEvent(new InputEvent('input', {bubbles: true, inputType: 'insertText', data: 'Foreground'}));
input.blur(); return true;
})()`), 'lane rename editor opens');
await sleep(180);
s = await shot();
assert(Object.values(s.clip.symbols.main.nodes).some(n => n.layout === 'sequence' && n.name === 'Foreground'),
'a lane name is editable and persisted in the document');
await dragClipBetweenLanes(12);
s = await shot();
const lanes = Object.values(s.clip.symbols.main.nodes).filter(n => n.layout === 'sequence');
assert.deepEqual(lanes.map(l => instances(s).filter(n => n.parent === l.id).length).sort(), [1, 3],
'a clip body can move from one lane to another');
assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: one timeline creates, trims, rolls, and ripples drawing-lane symbols');
console.log('PASS: generic lanes preview, rename, move, place, trim, roll, and ripple clips');
} finally {
if (ws?.readyState === WebSocket.OPEN) {
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' }));