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

62
docs/lane-handoff.md
View file

@ -1,12 +1,14 @@
# Lane and cel handoff
# Lane and symbol-clip handoff
Status (2026-10-01): the timeline is the one timing interface. Cels are ordinary
nodes with their own playback clock and appear as blocks on one row per drawing
lane. Blocks move by mouse; edge drags trim without overlap; Shift-right-edge
drags ripple every later cel; and the center of a shared cut composes the two
edge edits into a rolling edit. Linked audio follows picture moves while its
edges remain independently trimmable. Rotation and position corrections survive
regeneration and expose conflicts for removal or retry.
Status (2026-10-01): the timeline is the one timing interface. A lane is a
generic non-overlapping row of symbol clips; it is not a special drawing type.
Dropping a library symbol makes a naturally playing clip, while creating a new
empty symbol makes a one-frame held clip at the playhead. With no destination
lane, either operation creates one. Existing legacy root symbol rows can be
dragged into a lane. Blocks move by mouse; edge drags claim time by trimming
neighbors; Shift-edge drags ripple every later clip; and the center of a shared
cut composes the two edge edits into a rolling edit. Linked audio follows picture
moves while its edges remain independently trimmable.
The commits beginning at `3d3c1bb` are the argument for the model and are worth
reading before touching what they did — they are the design record, more than
@ -39,9 +41,10 @@ and do not reintroduce the others.
| word | means |
| --- | --- |
| instance | the `:kind`. The general thing, anywhere in a document |
| cel | an instance in a lane. One drawing, held for some duration |
| clip | an instance in a lane. It can hold one source frame or play a symbol naturally |
| cel | specifically a one-frame source held over a clip's duration; the empty-symbol/drawing creation policy |
| lane | a group with `:layout :sequence` |
| drawing | the content a cel names — an ordinary symbol |
| drawing | content authored into a symbol; not a different timeline node type |
| placement | ONLY where a node sits: `nest/placement`, and the transform that puts a face on the stage. Never the node itself |
`occurrence` and `exposure` are not words for a cel. **`exposure` means something
@ -82,19 +85,29 @@ decision, not a cleanup.
- **Refuse rather than guess.** Every command returns `{:clip :selection}` or
`{:refused why}`, never a half-applied edit. Where the model needs a choice
nobody has made, refusing and saying why is the behaviour, not a placeholder.
- **A cel is not a row.** Rows, expansion and selection are editor state. The
- **A clip is not a row.** Rows, expansion and selection are editor state. The
document has never known about rows and must not learn.
- **A lane is generic.** Drawing creation, library placement, and adopting an
existing root instance all produce the same child instance shape. The only
difference is playback policy: a new empty drawing holds source frame zero;
a dropped library symbol plays at speed one.
- **Placement claims time.** Lanes never store overlaps. A new or extended clip
trims, removes, or splits whatever previously owned the claimed interval.
Real compositing overlap uses another lane, where ordering remains explicit.
## Current timeline interaction
- Creating a symbol inside an aimed drawing lane creates a one-frame cel at the
playhead. Drawing a polygon uses the existing cel there or creates the same
one-frame cel when the frame is empty.
- Dragging a cel body moves it. A linked audio node follows a picture move;
- Creating a symbol inside an aimed lane creates a one-frame held clip at the
playhead. With no aimed lane it first creates a lane. Drawing a polygon uses
the existing clip there or creates the same one-frame clip when the frame is
empty.
- Dropping any library symbol into a lane creates a natural-duration playing
clip. Dropping it on unclaimed timeline or stage space first creates a lane.
- Dragging a clip body moves it. A linked audio node follows a picture move;
moving or trimming the audio itself remains independent.
- Dragging a right edge changes its endpoint. Growth consumes adjacent spans
instead of overlapping them. Shift-drag inserts or removes lane time by moving
every later cel by the same delta.
every later clip by the same delta.
- At a shared boundary, the left and right hit zones trim one side. The center
is a rolling edit: right-edge resize followed by left-edge resize at one frame.
- Split, trim-in, and trim-out are direct buttons and are disabled without an
@ -156,9 +169,10 @@ The implemented correction slice and its remaining UI limits are recorded in
## Known gaps and traps
- **Audio lanes do not work.** `symbol/lane-problems` requires `:instance`
children, so an audio node in a lane is rejected outright. `lane-model.md`
says a lane may hold visual OR audio cels and should reject only a mixture.
- **Audio remains outside visual lanes.** `symbol/lane-problems` deliberately
requires symbol instances. Audio is still an independent root node that can
link to picture; making audio itself lane-based would need an explicit lane
capability rather than a mixed child rule.
- **`:z` is required on cels and means nothing there.** A lane never has two
cels on one frame, so draw order between them cannot matter. `node/problems`
requires `:z` on every node uniformly, which is its own kind of simplicity —
@ -172,9 +186,9 @@ The implemented correction slice and its remaining UI limits are recorded in
pose selection and plate drawings/tracing, instance-specific picture-rate
requests, `pose/put-cut` addressing only `:main`. It predates the lane model
and nobody has squared the two.
- **The button row in the timeline pane is a test harness, not a design.** It is
how the commands were made reachable and provable. `lane-model.md` describes
the real cel action strip, the breadcrumb and the location bar; none exist.
- **Slip and retime are still absent.** The timeline action strip now applies
split/trim uniformly to a selected root or lane clip, but source-time slip and
retime still need their own proved semantics before they become controls.
- **`shadow-cljs release app` clobbers the dev bundle.** Both builds write
`../static/arthur/js`, which Django serves, and the optimized build does not
export the `arthur` global — so after a release the browser tests fail with
@ -186,14 +200,14 @@ The implemented correction slice and its remaining UI limits are recorded in
From `frontend/`:
npx shadow-cljs compile test && node out/node-tests.js # 437 tests, 5,804 assertions
npx shadow-cljs compile test && node out/node-tests.js # 469 tests, 9,592 assertions
npx shadow-cljs compile app # the bundle Django serves
npx shadow-cljs release app # then `compile app` again — see above
The browser tests need the Django dev server up (`mise exec -- python manage.py
runserver 8778` from the repo root) and a compiled dev bundle:
node --experimental-websocket test/browser/lane.mjs # the lane/cel flow
node --experimental-websocket test/browser/lane.mjs # generic symbol-lane flow
CHROME=/usr/bin/chromium node --experimental-websocket test/browser/take.mjs
`take.mjs` defaults to a macOS Chrome path, hence `CHROME=`. It writes a real

7
docs/lane-model.md
View file

@ -1,6 +1,6 @@
# The Lane Model
Revised 2026-10-01. Cel ownership, source playback, one-row drawing lanes,
Revised 2026-10-01. Clip ownership, source playback, one-row generic lanes,
direct clip movement and edge editing, correction evaluation, and correction
authoring for rotation and position are implemented. The former cel-sheet
projection was removed: the timeline is the single timing interface. Sections
@ -147,8 +147,9 @@ cel transform and then the content's own transform.
The interval in lane time is derived through `:time`; do not also store parent
start/end values. Sequence children require finite intervals and positive
placement rates. Ordering and overlap checks use the mapped intervals, not `:z`.
The sequence group may contain visual cels or audio cels; its
capability must reject an incompatible mixture rather than infer it per frame.
The current sequence group contains visual symbol clips. Audio remains an
independent root node (and can be linked to picture); if audio lanes are added,
their capability must be explicit rather than inferred per frame.
A source reference is fixed within a cel. The lane changes content when
another cel becomes active. This is a deliberate revision of the original

99
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]))
(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 "drawings" :kind :group :layout :sequence
:z (str "z-" id)})
:selection 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

138
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"})]
@ -596,17 +608,21 @@
(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)]]
(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 #(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.
(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))))))))))
(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
;; 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/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]])))))
(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])}]}]]))

214
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)))]
(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)]))))))
(: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,29 +587,44 @@
: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)
: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 (fn [e] (.stopPropagation e)
(when source (rf/dispatch [::pb/open-symbol source])))}
(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]
(when select
(if joined?
[:span.tl-junction
{:title "Left: trim left · center: roll cut · right: trim right"
@ -528,13 +635,14 @@
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))))}]
(< 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)}])
: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)}]]))
: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' }));

6
static/arthur/app.css
View file

@ -1000,6 +1000,9 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.tl-label:hover:not(.on) { background: #fff; }
.tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; }
.tl-label .kind { color: var(--dim); }
.tl-name-input { min-width: 0; flex: 1; font: inherit; }
.tl-rename { margin-left: auto; padding: 0 3px; border: 0; background: none; color: var(--dim); }
.tl-rename:hover { color: var(--fg); }
/* A fixed-width cell whether or not there is a triangle in it, so names at the
same depth line up down the column. */
@ -1081,7 +1084,8 @@ 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; }
.tl-span.ghost, .tl-label.ghost, .tl-cel.ghost { pointer-events: none; }
.tl-cel.ghost { background: transparent; border: 1px dashed var(--sel); color: var(--sel); }
/* 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. */