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 Status (2026-10-01): the timeline is the one timing interface. A lane is a
nodes with their own playback clock and appear as blocks on one row per drawing generic non-overlapping row of symbol clips; it is not a special drawing type.
lane. Blocks move by mouse; edge drags trim without overlap; Shift-right-edge Dropping a library symbol makes a naturally playing clip, while creating a new
drags ripple every later cel; and the center of a shared cut composes the two empty symbol makes a one-frame held clip at the playhead. With no destination
edge edits into a rolling edit. Linked audio follows picture moves while its lane, either operation creates one. Existing legacy root symbol rows can be
edges remain independently trimmable. Rotation and position corrections survive dragged into a lane. Blocks move by mouse; edge drags claim time by trimming
regeneration and expose conflicts for removal or retry. 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 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 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 | | word | means |
| --- | --- | | --- | --- |
| instance | the `:kind`. The general thing, anywhere in a document | | 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` | | 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 | | 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 `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 - **Refuse rather than guess.** Every command returns `{:clip :selection}` or
`{:refused why}`, never a half-applied edit. Where the model needs a choice `{: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. 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. 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 ## Current timeline interaction
- Creating a symbol inside an aimed drawing lane creates a one-frame cel at the - Creating a symbol inside an aimed lane creates a one-frame held clip at the
playhead. Drawing a polygon uses the existing cel there or creates the same playhead. With no aimed lane it first creates a lane. Drawing a polygon uses
one-frame cel when the frame is empty. the existing clip there or creates the same one-frame clip when the frame is
- Dragging a cel body moves it. A linked audio node follows a picture move; 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. moving or trimming the audio itself remains independent.
- Dragging a right edge changes its endpoint. Growth consumes adjacent spans - Dragging a right edge changes its endpoint. Growth consumes adjacent spans
instead of overlapping them. Shift-drag inserts or removes lane time by moving 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 - 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. 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 - 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 ## Known gaps and traps
- **Audio lanes do not work.** `symbol/lane-problems` requires `:instance` - **Audio remains outside visual lanes.** `symbol/lane-problems` deliberately
children, so an audio node in a lane is rejected outright. `lane-model.md` requires symbol instances. Audio is still an independent root node that can
says a lane may hold visual OR audio cels and should reject only a mixture. 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 - **`: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` 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 — 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 pose selection and plate drawings/tracing, instance-specific picture-rate
requests, `pose/put-cut` addressing only `:main`. It predates the lane model requests, `pose/put-cut` addressing only `:main`. It predates the lane model
and nobody has squared the two. and nobody has squared the two.
- **The button row in the timeline pane is a test harness, not a design.** It is - **Slip and retime are still absent.** The timeline action strip now applies
how the commands were made reachable and provable. `lane-model.md` describes split/trim uniformly to a selected root or lane clip, but source-time slip and
the real cel action strip, the breadcrumb and the location bar; none exist. retime still need their own proved semantics before they become controls.
- **`shadow-cljs release app` clobbers the dev bundle.** Both builds write - **`shadow-cljs release app` clobbers the dev bundle.** Both builds write
`../static/arthur/js`, which Django serves, and the optimized build does not `../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 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/`: 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 compile app # the bundle Django serves
npx shadow-cljs release app # then `compile app` again — see above 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 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: 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 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 `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 # 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 direct clip movement and edge editing, correction evaluation, and correction
authoring for rotation and position are implemented. The former cel-sheet authoring for rotation and position are implemented. The former cel-sheet
projection was removed: the timeline is the single timing interface. Sections 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 The interval in lane time is derived through `:time`; do not also store parent
start/end values. Sequence children require finite intervals and positive start/end values. Sequence children require finite intervals and positive
placement rates. Ordering and overlap checks use the mapped intervals, not `:z`. placement rates. Ordering and overlap checks use the mapped intervals, not `:z`.
The sequence group may contain visual cels or audio cels; its The current sequence group contains visual symbol clips. Audio remains an
capability must reject an incompatible mixture rather than infer it per frame. 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 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 another cel becomes active. This is a deliberate revision of the original

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

@ -1,11 +1,11 @@
(ns arthur.domain.lane (ns arthur.domain.lane
"The commands that need a SEQUENCE: make a lane, put drawings in it, change "The commands that need a SEQUENCE: make a lane, place symbol clips in it,
how long they are exposed, empty part of it, and decide which cels share change how long they are exposed, empty part of it, and decide which held
content. drawing clips share content.
WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a 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 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 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 node's span or position, which is a fact every node has, so they live in
@ -56,7 +56,7 @@
:else :else
(let [[_ boundary] (node/placed-span n) (let [[_ boundary] (node/placed-span n)
later (filter #(>= (first (node/placed-span %)) boundary) 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 (assoc-in nodes [id :span 1] (+ (second span) (* rate delta)))
nodes (reduce (fn [ns sibling] nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) (update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
@ -76,7 +76,7 @@
n (get nodes id) n (get nodes id)
lane (get nodes (:parent n)) lane (get nodes (:parent n))
[lo old-out] (when n (node/placed-span 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 later (when members
(remove #(= id (:id %)) (remove #(= id (:id %))
(filter #(>= (first (node/placed-span %)) old-out) members))) (filter #(>= (first (node/placed-span %)) old-out) members)))
@ -118,7 +118,7 @@
earlier (when (node/lane? lane) earlier (when (node/lane? lane)
(remove #(= id (:id %)) (remove #(= id (:id %))
(filter #(<= (second (node/placed-span %)) old-in) (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))] broken (first (symbol/lane-problems nodes))]
(cond (cond
(not (node/lane? lane)) {:refused "select a cel in a lane"} (not (node/lane? lane)) {:refused "select a cel in a lane"}
@ -178,7 +178,7 @@
[clip sid lane-id [a b] {:keys [id]}] [clip sid lane-id [a b] {:keys [id]}]
(let [nodes (get-in clip [:symbols sid :nodes]) (let [nodes (get-in clip [:symbols sid :nodes])
lane (get nodes lane-id) 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 spanning (when members
(first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b))) (first (filter #(let [[lo hi] (node/placed-span %)] (and (< lo a) (> hi b)))
members)))] members)))]
@ -205,12 +205,81 @@
(span/finish clip sid nodes (or (when spanning id) lane-id) :keep))))) (span/finish clip sid nodes (or (when spanning id) lane-id) :keep)))))
(defn add-lane [clip sid id] (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])
{:refused "the symbol is missing or the lane ID is already used"} front (last (sort (keep (fn [[_ n]] (when (nil? (:parent n)) (:z n))) nodes)))]
{:clip (assoc-in clip [:symbols sid :nodes id] (if (or (nil? (clip/symbol clip sid)) (get nodes id))
{:id id :name "drawings" :kind :group :layout :sequence {:refused "the symbol is missing or the lane ID is already used"}
:z (str "z-" id)}) {:clip (assoc-in clip [:symbols sid :nodes 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 ;; putting drawings in a lane
@ -239,7 +308,7 @@
"Where lane `lane-id`'s occupied frames stop, in its own time." "Where lane `lane-id`'s occupied frames stop, in its own time."
[nodes lane-id] [nodes lane-id]
(apply max 0 (map #(second (node/placed-span %)) (apply max 0 (map #(second (node/placed-span %))
(symbol/lane-cels nodes lane-id)))) (symbol/lane-clips nodes lane-id))))
(defn- place (defn- place
"Put a held cel of `drawing-id` into `lane-id` at lane frame `at`, and "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) [lo hi] (node/placed-span n)
later (when ripple? later (when ripple?
(filter #(>= (first (node/placed-span %)) lo) (filter #(>= (first (node/placed-span %)) lo)
(symbol/lane-cels nodes lane-id))) (symbol/lane-clips nodes lane-id)))
nodes (reduce (fn [ns sibling] nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo)))
(assoc nodes id n) later) (assoc nodes id n) later)
@ -280,7 +349,7 @@
inside (when (number? at) inside (when (number? at)
(some (fn [n] (let [[lo hi] (node/placed-span n)] (some (fn [n] (let [[lo hi] (node/placed-span n)]
(when (< lo at hi) n))) (when (< lo at hi) n)))
(symbol/lane-cels nodes lane-id)))] (symbol/lane-clips nodes lane-id)))]
(cond (cond
(not (node/lane? lane)) "select a lane" (not (node/lane? lane)) "select a lane"
(contains? nodes id) "the new cel ID is already used" (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] [clip sid nodes selection extent]
(let [sym (clip/symbol clip sid) (let [sym (clip/symbol clip sid)
reach (for [[id n] nodes :when (node/lane? n) 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) :let [m (symbol/frame-map nodes id)
end (second (node/placed-span child))]] end (second (node/placed-span child))]]
(when m (+ (:at m) (/ end (:rate m))))) (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 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 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 — 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." The right piece is the selection, because it is the piece that was made."
[clip sid id cut new-id] [clip sid id cut new-id]

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

@ -90,8 +90,8 @@
[nodes id] [nodes id]
(dec (count (lineage nodes id)))) (dec (count (lineage nodes id))))
(defn lane-cels (defn lane-clips
"The cels of lane `lane`, in the order they are exposed. "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 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. 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 the parent and stencil references, rather than wherever a command happens to
build one. 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 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 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." 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)))] intervals (sort-by first (map node/placed-span (filter valid? children)))]
(concat (concat
(for [n children :when (not (valid? n))] (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)) (when (some (fn [[[_ b] [c _]]] (> b c)) (partition 2 1 intervals))
[(str "lane " id " has overlapping cels")]))))) [(str "lane " id " has overlapping clips")])))))
nodes))) nodes)))
(defn order (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 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 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." 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.correction :as correction]
[arthur.domain.gesture :as gesture] [arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
@ -32,6 +33,17 @@
[arthur.footage.store :as store] [arthur.footage.store :as store]
[re-frame.core :as rf])) [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 (defn selected
"`db` with `selection` selected, and nothing aimed. "`db` with `selection` selected, and nothing aimed.
@ -431,14 +443,14 @@
db))) db)))
(defn into-the-lane (defn into-the-lane
"Where a polygon drawn in the CEL SHEET goes: the row path of the cel the "Where a polygon drawn with a lane aimed goes: the path of the held clip the
aimed lane exposes at the playhead, and the clip that cel is in. `{:clip lane exposes at the playhead, and the document containing it. `{:clip :path}`,
:path}`, or `{:refused why}`. or `{:refused why}`.
A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The sheet is a drawing-lane mode A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The frame under the playhead is
and the frame under the playhead is where the drawing belongs, so drawing on where the drawing belongs, so drawing on an empty frame makes the one-frame
an empty frame makes the drawing that was missing — which is the whole reason held clip that was missing. The gesture already says what the removed drawing
there is no `new drawing` button any more: the gesture already says it. controls used to say.
`overwrite-drawing` rather than `append-drawing`, because a gap already has `overwrite-drawing` rather than `append-drawing`, because a gap already has
the room. Appending RIPPLES everything after it later by the new cel's the room. Appending RIPPLES everything after it later by the new cel's
@ -456,7 +468,7 @@
cel (when (integer? at) cel (when (integer? at)
(some (fn [c] (let [[lo hi] (node/placed-span c)] (some (fn [c] (let [[lo hi] (node/placed-span c)]
(when (and (<= lo at) (< at hi)) 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 (cond
(not (integer? at)) (not (integer? at))
{:refused "the playhead is not on one frame of this lane"} {:refused "the playhead is not on one frame of this lane"}
@ -471,7 +483,7 @@
(defn polygon-landing (defn polygon-landing
"Choose the document and row path a finished polygon is drawn into. "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. 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." With no lane aimed, ordinary target-based drawing is unchanged."
[clip st db] [clip st db]
@ -481,7 +493,7 @@
(defn beginning-polygon (defn beginning-polygon
"Enter polygon mode, first materializing a drawing at the playhead when a "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 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 already the current cel while points are being placed. Cancelling the polygon
@ -567,24 +579,24 @@
(rf/reg-event-db (rf/reg-event-db
::new-symbol ::new-symbol
;; `where` is `:inside` — in whatever the target names — or `:top`, in the open ;; `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 ;; symbol regardless of it. A lane is the temporal form of this same operation:
;; operation: inside it, a new symbol is a one-frame cel at the playhead. ;; inside it, a new empty symbol is a one-frame held clip at the playhead.
(fn [db [_ where]] (fn [db [_ where]]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (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]) open (get-in db [:ui :open])
owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame]))) owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame])))
at (when (and drawing-lane (number? owner)) at (when (and target-lane (number? owner))
(lane/lane-frame clip open (:id drawing-lane) owner)) (lane/lane-frame clip open (:id target-lane) owner))
drawing-id (clip/fresh-id clip) drawing-id (clip/fresh-id clip)
cel-id (random-uuid) cel-id (random-uuid)
down (if (= :top where) [] (where-new-goes clip db)) down (if (= :top where) [] (where-new-goes clip db))
{host :sid frame :frame} (nest/inside clip st open down {host :sid frame :frame} (nest/inside clip st open down
(get-in db [:playback :frame])) (get-in db [:playback :frame]))
uuid (random-uuid)] lane-id (random-uuid)]
(if drawing-lane (if target-lane
(let [result (if (integer? at) (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 {:extent :grow-symbol
:remainder-id (random-uuid)}) :remainder-id (random-uuid)})
{:refused "the playhead is not on one frame of this lane"})] {:refused "the playhead is not on one frame of this lane"})]
@ -594,19 +606,23 @@
(edit/transaction (constantly (:clip result))) (edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node open cel-id [cel-id]])))) (assoc-in [:ui :selection] [:node open cel-id [cel-id]]))))
(if-not host (if-not host
(update db :project merge (update db :project merge
{:status "what you are adding to is not on screen at this frame"}) {: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)
(-> db result (if (:refused prepared) prepared
(edit/transaction #(clip/new-symbol % host drawing-id frame uuid)) (lane/overwrite-drawing (:clip prepared) host lane-id
;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the cel-id drawing-id frame
;; next thing made goes in it; the outline says so before anybody {:extent :grow-symbol
;; has to find out by drawing. :remainder-id (random-uuid)}))]
(aimed made) (if-let [why (:refused result)]
;; Open every row down to it, or the new row is inside a closed one (update db :project merge {:status why})
;; and the button looks like it did nothing. (-> db
(update-in [:ui :expanded] (fnil into #{}) (edit/transaction (constantly (:clip result)))
(rest (reductions conj [] down)))))))))) (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 ;; a drop in flight
@ -629,15 +645,42 @@
(rf/reg-event-db (rf/reg-event-db
::drop-symbol ::drop-symbol
;; `point` is the stage pixel it was dropped on, or nil from the timeline. ;; A symbol dropped on a lane becomes a naturally playing clip in that lane.
(fn [db [_ sid frame point]] ;; With no lane under it, make one: new timeline/stage placement therefore
(let [uuid (random-uuid) ;; never invents another permanent row-per-symbol track.
host (get-in db [:ui :open])] (fn [db [_ source-id frame point target]]
(-> db (let [{document :clip st :store} (store/entry (:clip/current db))
(update :ui dissoc :drop) open (get-in db [:ui :open])
(edit/edit-entry #(update % :clip clip/place-symbol (:store %) selected (get-in db [:ui :selection])
host sid (* frame (:rate (clip/grid-time (:clip %) host))) uuid point)) [_ selected-sid selected-id] selected
(assoc-in [:ui :selection] [:node host uuid [uuid]]))))) 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 (rf/reg-event-db
::drop-sound ::drop-sound
@ -649,6 +692,29 @@
(edit/edit #(clip/place-sound % host source label length rate (* frame (:rate (clip/grid-time % host))) uuid)) (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]]))))) (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 ;; moving rows between symbols
;; ;;

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

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

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

@ -199,5 +199,5 @@
", ignoring what is aimed") ", ignoring what is aimed")
:on-click #(rf/dispatch [::ui/new-symbol :top])} :on-click #(rf/dispatch [::ui/new-symbol :top])}
{:label "lane" {: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])}]}]])) :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) :label (node-label id n)
:kind :node :kind :node
:node-kind (:kind n) :node-kind (:kind n)
:lane? (node/lane? n)
:of (node/source n) :of (node/source n)
:select [:node sid id rpath] :select [:node sid id rpath]
:expandable? true :expandable? true
@ -145,12 +146,11 @@
(distinct)) (distinct))
(vals channels)) (vals channels))
:dense? (boolean (some :dense (vals channels)))}] :dense? (boolean (some :dense (vals channels)))}]
;; AN CEL IS NOT A ROW. A lane's drawings are cel ;; A CLIP IS NOT A ROW. A lane's symbol clips are
;; blocks on the lane's own row, so a lane of twelve ;; blocks on the lane's own row, so twelve clips are
;; cels is one row and not twelve — which is the ;; still one row. The clip remains independently
;; vertical growth that made a keyed source look ;; selectable and addressable; only its presentation
;; necessary. The cel is still the thing selected ;; is shared.
;; and addressed; only its presentation is shared.
(if (node/lane? (get-in sym [:nodes (:parent n)])) (if (node/lane? (get-in sym [:nodes (:parent n)]))
[] []
(let [row (cond-> row (let [row (cond-> row
@ -163,7 +163,7 @@
:source (node/source child) :source (node/source child)
:span (mapv self (node/placed-span child)) :span (mapv self (node/placed-span child))
:select [:node sid (:id child) (conj path (:id 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? (if-not open?
[row] [row]
(-> [row] (-> [row]
@ -221,6 +221,20 @@
x (- (.-clientX event) (.-left box))] x (- (.-clientX event) (.-left box))]
(-> (/ (* x frames) (.-width box)) js/Math.floor (max 0) (min (dec frames))))) (-> (/ (* 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 ;; the panes
@ -296,8 +310,8 @@
(doall (for [[r label] [[0.25 "¼×"] [0.5 "½×"] [1.0 "1×"] [2.0 "2×"] [4.0 "4×"]]] (doall (for [[r label] [[0.25 "¼×"] [0.5 "½×"] [1.0 "1×"] [2.0 "2×"] [4.0 "4×"]]]
^{:key r} [:option {:value r} label]))]] ^{:key r} [:option {:value r} label]))]]
[:span.sep] [:span.sep]
;; The same direct timing operations apply to any selected span, whether it ;; The same direct timing operations apply to any selected symbol clip,
;; is at the root or is a cel inside a drawing lane. ;; whether it is still a legacy root node or lives in a lane.
[:div.group.timing-controls {:aria-label "timing"} [:div.group.timing-controls {:aria-label "timing"}
[:button {:disabled (not cuttable?) :aria-label "split" [:button {:disabled (not cuttable?) :aria-label "split"
:title "split the selected clip at the playhead" :title "split the selected clip at the playhead"
@ -352,14 +366,21 @@
on every render after, which would fight a person scrolling away." on every render after, which would fight a person scrolling away."
(memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"})))))) (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]} (defn- label-cell [{:keys [path depth label kind node-kind lane? select expandable? expanded? of via]}
selection target over solo tracing] selection target over solo tracing renaming draft]
(let [node? (= :node kind) (let [node? (= :node kind)
;; AIMED IS NOT SELECTED, so it does not wear the selected class. The ;; 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 ;; 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 ;; inspector is showing. One row is often both and must still say which
;; of the two it is being. ;; of the two it is being.
aimed? (and node? (= path (:path target))) 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] [over-path where] @over]
[:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on") [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on")
(when aimed? " aimed") (when aimed? " aimed")
@ -371,6 +392,7 @@
(if (= :instance node-kind) " drop-into" " drop-group")))) (if (= :instance node-kind) " drop-into" " drop-group"))))
:style {:padding-left (str (+ 4 (* 11 depth)) "px")} :style {:padding-left (str (+ 4 (* 11 depth)) "px")}
:title label :title label
:tab-index (when lane? 0)
:ref (when (and select (= select selection)) (reveal selection)) :ref (when (and select (= select selection)) (reveal selection))
;; A LABEL AIMS. Clicking a row's name says "I am working ;; A LABEL AIMS. Clicking a row's name says "I am working
;; here", which is a statement about a place in the document; ;; here", which is a statement about a place in the document;
@ -379,7 +401,14 @@
;; the first moves where new drawings and symbols go. ;; the first moves where new drawings and symbols go.
:on-click #(when select (rf/dispatch [::ui/aim select])) :on-click #(when select (rf/dispatch [::ui/aim select]))
;; An instance's row opens the symbol it places, as a tab. ;; 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 ;; 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 ;; 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 ;; grouped with it into a new one; onto an edge of either, to be
@ -390,7 +419,7 @@
(.stopPropagation e) (.stopPropagation e)
(.setData (.-dataTransfer e) "text/plain" "row") (.setData (.-dataTransfer e) "text/plain" "row")
(set! (.. e -dataTransfer -effectAllowed) "move") (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-end (fn [_] (reset! over nil) (drag/done!))
:on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e))) :on-drag-enter (fn [^js e] (when (takes? path node-kind) (.preventDefault e)))
:on-drag-over (fn [^js e] :on-drag-over (fn [^js e]
@ -419,8 +448,25 @@
(.stopPropagation e) (.stopPropagation e)
(rf/dispatch [::ui/toggle-row path]))} (rf/dispatch [::ui/toggle-row path]))}
(when expandable? (if expanded? "▾" "▸"))] (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 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 ;; 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, ;; 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 ;; 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 "`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 :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." 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) (let [active-row (:row @sliding)
slide (fn [^js e] slide (fn [^js e]
(let [{from :row x0 :x width :width} @sliding] (let [{from :row x0 :x width :width} @sliding]
(when (= path from) (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)))
(when (not= df (:df @sliding)) drag (:drag @sliding)
(swap! sliding assoc :df df) [target-el target] (when drag (lane-under e))
(rf/dispatch [::ui/sliding (:path @sliding) df crossing? (and target (not= target (:source-lane drag)))
(:kind @sliding) (:ripple? @sliding) target-frame (when crossing?
(:other @sliding)])))))) (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?] done (fn [commit?]
(when (= path (:row @sliding)) (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) (reset! sliding nil)
(rf/dispatch (if commit? [::ui/slide path df kind ripple? other] (cond
[::ui/sliding nil]))))) (and commit? target-lane drag)
begin! (fn [^js e actual-path gesture-kind actual-select other] (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")] (let [track (.closest (.-currentTarget e) ".tl-track")]
(.stopPropagation e) (.stopPropagation e)
(when actual-select (rf/dispatch [::ui/select actual-select])) (when actual-select (rf/dispatch [::ui/select actual-select]))
(reset! sliding {:row path :path actual-path :kind gesture-kind (reset! sliding {:row path :path actual-path :kind gesture-kind
:other other :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)) :ripple? (and (= :out gesture-kind) (.-shiftKey e))
:x (.-clientX e) :df 0 :x (.-clientX e) :df 0
:width (.-width (.getBoundingClientRect track))}) :width (.-width (.getBoundingClientRect track))})
@ -483,7 +551,31 @@
;; goes on when the bar has slid off the ruler and is no longer drawn. ;; goes on when the bar has slid off the ruler and is no longer drawn.
{:on-pointer-move slide {:on-pointer-move slide
:on-pointer-up (fn [e] (slide e) (done true)) :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 ;; 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. ;; 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))])] (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))) "%")} :width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
:on-pointer-down :on-pointer-down
(when select (when select
#(begin! % (or slides path) :slide select nil))} #(begin! % (or slides path) :slide select nil nil))}
(when select (when select
[:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" [: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 (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))) :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))] in (max 0 (first span)) out (min frames (second span))]
:when (< in out)] :when (< in out)]
^{:key (str id)} ^{:key (str id)}
[:button.tl-cel [: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) :style {:position "absolute" :left (edge% in frames)
:width (str (* 100 (/ (- out in) (max 1 frames))) "%") :width (str (* 100 (/ (- out in) (max 1 frames))) "%")
:top "2px" :bottom "2px" :overflow "visible" :padding "0 3px"} :top "2px" :bottom "2px" :overflow "visible" :padding "0 3px"}
:on-pointer-down #(begin! % (nth select 3) :slide select nil) :on-pointer-down (when select
:on-click (fn [e] (.stopPropagation e) #(begin! % (nth select 3) :slide select nil
(rf/dispatch [::ui/select select]) {:selection select :label label :in in
(rf/dispatch [::pb/seek (js/Math.floor in)])) :duration (- out in)}))
:on-double-click (fn [e] (.stopPropagation e) :on-click (when select
(when source (rf/dispatch [::pb/open-symbol source])))} (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] [:span.tl-cel-label label]
(if joined? (when select
[:span.tl-junction (if joined?
{:title "Left: trim left · center: roll cut · right: trim right" [:span.tl-junction
:on-pointer-down {:title "Left: trim left · center: roll cut · right: trim right"
(fn [^js e] :on-pointer-down
(let [box (.getBoundingClientRect (.-currentTarget e)) (fn [^js e]
x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box))) (let [box (.getBoundingClientRect (.-currentTarget e))
left-path (nth (:select prev) 3) x (/ (- (.-clientX e) (.-left box)) (max 1 (.-width box)))
right-path (nth select 3)] left-path (nth (:select prev) 3)
(cond right-path (nth select 3)]
(< x 0.34) (begin! e left-path :out (:select prev) nil) (cond
(> x 0.66) (begin! e right-path :in select nil) (< x 0.34) (begin! e left-path :out (:select prev) nil nil)
:else (begin! e right-path :roll select left-path))))}] (> x 0.66) (begin! e right-path :in select nil nil)
[:span.tl-edge.in {:title "Drag start" :else (begin! e right-path :roll select left-path nil))))}]
:on-pointer-down #(begin! % (nth select 3) :in select nil)}]) [:span.tl-edge.in {:title "Drag start"
[:span.tl-edge.out {:title "Drag endpoint · Shift-drag ripples later clips" :on-pointer-down #(begin! % (nth select 3) :in select nil nil)}]))
:on-pointer-down #(begin! % (nth select 3) :out select 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 ;; 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. ;; block that says less than the bar behind it already does.
(when-not dense? (when-not dense?
@ -547,7 +655,9 @@
;; The row a carried row is over and which part of it, for the ;; The row a carried row is over and which part of it, for the
;; highlight. ;; highlight.
over (r/atom nil) 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]) (let [clip @(rf/subscribe [::render/clip])
frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frames (max 1 (or @(rf/subscribe [::render/frames]) 1))
frame @(rf/subscribe [::playback/frame]) 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 ;; 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 ;; 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. ;; 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 {:path [::drop] :depth 0 :kind :ghost
:label (str "+ " (:label drop)) :label (str "+ " (:label drop))
:span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))] :span [(:frame drop) (+ (:frame drop) (or (:frames drop) 1))]
:keys []}) :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)) (and ghost (not (:sound? drop))) (cons ghost))
sounds (cond->> (sound-rows clip open expanded) sounds (cond->> (sound-rows clip open expanded)
(and ghost (:sound? drop)) (cons ghost)) (and ghost (:sound? drop)) (cons ghost))
@ -601,7 +720,7 @@
(doall (for [row visible] (doall (for [row visible]
(with-meta (if (= :section (:kind row)) (with-meta (if (= :section (:kind row))
[:div.tl-label.tl-section (:label 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))})))] {:key (str (:path row))})))]
[:div.tl-tracks [:div.tl-tracks
{:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
@ -610,8 +729,17 @@
(.preventDefault e) (.preventDefault e)
(drag/hover! :timeline (frame-at e frames) nil))) (drag/hover! :timeline (frame-at e frames) nil)))
:on-drag-leave (fn [^js e] :on-drag-leave (fn [^js e]
(when-not (.contains (.-currentTarget e) (.-relatedTarget e)) (let [box (.getBoundingClientRect (.-currentTarget e))
(rf/dispatch [::ui/drop-clear]))) 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 ;; In its own coordinates: dropped in time, nowhere in particular in
;; space, so what was drawn at a place stays at that place. ;; space, so what was drawn at a place stays at that place.
:on-drop (fn [^js e] :on-drop (fn [^js e]

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

@ -102,16 +102,16 @@
:extent :grow-symbol})) :extent :grow-symbol}))
shrink (:clip (lane/resize-out doc :main :a 2 {:ripple? true}))] shrink (:clip (lane/resize-out doc :main :a 2 {:ripple? true}))]
(is (= [[0 6] [6 8] [8 12]] (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") "a normal grow eats the beginning of the adjacent cel")
(is (= [[0 9] [9 12]] (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") "a long grow removes wholly consumed cels and trims the survivor")
(is (= [[0 6] [6 10] [10 14]] (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") "shift-grow moves every later cel")
(is (= [[0 2] [2 6] [6 10]] (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") "shift-shrink pulls every later cel left")
(is (:refused (lane/resize-out doc :main :a 0 {}))) (is (:refused (lane/resize-out doc :main :a 0 {})))
(is (:refused (lane/resize-out doc :main :a 2.5 {}))))) (is (:refused (lane/resize-out doc :main :a 2.5 {})))))
@ -122,13 +122,13 @@
right-only (:clip (lane/resize-in doc :main :b 6)) right-only (:clip (lane/resize-in doc :main :b 6))
grown-left (:clip (lane/resize-in doc :main :b 2))] grown-left (:clip (lane/resize-in doc :main :b 2))]
(is (= [[0 6] [6 8] [8 12]] (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") "the shared cut moves without moving either clip")
(is (= [[0 4] [6 8] [8 12]] (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") "the right side of the junction trims only the right clip")
(is (= [[0 2] [2 8] [8 12]] (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") "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 :b 0)))
(is (:refused (lane/roll doc :main :a :insert 6))))) (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 (= 0 (get-in b [:symbols :main :nodes :b :playback :speed])))
(is (:refused (lane/append-drawing b :main :girl :a :new {}))))) (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 (deftest fractional-placement-rates-convert-the-hold-delta
(let [doc (-> (document) (let [doc (-> (document)
(assoc-in [:symbols :main :nodes :a :time :rate] 2) (assoc-in [:symbols :main :nodes :a :time :rate] 2)
@ -557,7 +590,7 @@
;; drawing must not quietly shorten the film. ;; drawing must not quietly shorten the film.
(let [doc (document) (let [doc (document)
empty-lane (:clip (lane/blank doc :main :girl [0 12] {}))] 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 (= 12 (get-in empty-lane [:symbols :main :frames])))
(is (empty? (clip/problems empty-lane))) (is (empty? (clip/problems empty-lane)))
;; Growing is still the caller's word, and only ever grows. ;; 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); 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, 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'); await click('inside');
let s = await shot(); 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, assert.equal(await evaluate(`document.querySelectorAll('.cel-sheet, [aria-label="time view"]').length`), 0,
'there is one temporal interface'); 'there is one temporal interface');
assert.equal(await evaluate('document.querySelectorAll(".timing-controls > button").length'), 3, 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); await drag('.tl-cel:first-of-type .tl-edge.out', 2);
assert.deepEqual(placed(await shot()), [[0, 6], [6, 7], [7, 8]], assert.deepEqual(placed(await shot()), [[0, 6], [6, 7], [7, 8]],
'ordinary growth trims adjacent spans and never overlaps'); '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)); 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 { } finally {
if (ws?.readyState === WebSocket.OPEN) { if (ws?.readyState === WebSocket.OPEN) {
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' })); 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:hover:not(.on) { background: #fff; }
.tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; } .tl-label .name { min-width: 0; overflow: hidden; text-overflow: ellipsis; }
.tl-label .kind { color: var(--dim); } .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 /* A fixed-width cell whether or not there is a triangle in it, so names at the
same depth line up down the column. */ 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. */ /* 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, /* 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. */ by its middle; in front of it or behind it, by its top or bottom edge. */