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

perfect target area thing

Browse source
This commit is contained in:
Your Name 2026-10-03 00:39:07 -04:00
parent 664252e0fc
commit 5bcf22e458
23 changed files with 668 additions and 432 deletions
Download patch file Download diff file Expand all files Collapse all files

43
frontend/src/arthur/domain/creation.cljs Normal file
View file

@ -0,0 +1,43 @@
(ns arthur.domain.creation
"Resolve where a new thing goes from the primary selection and playhead.
This namespace owns no editor state. A row address is a preference; walking
the occurrence path at one frame answers which preferred or enclosing symbol
is actually available. See `docs/creating-in.md`."
(:require [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.symbol :as symbol]))
(defn preferred-path
"The container path structurally implied by `selection`.
Selecting an instance means inside it. Selecting any other node means its
containing symbol. An empty or non-node selection means the open symbol."
[document selection]
(let [[kind sid id selected-path] selection
path (when (= :node kind)
(vec (or (seq selected-path) (when id [id]))))]
(cond
(empty? path) []
(= :instance (get-in document [:symbols sid :nodes id :kind])) path
:else (vec (butlast path)))))
(defn target
"The nearest creation context available at `frame` of `open`.
Every non-empty candidate is validated by `nest/inside`, so every enclosing
symbol occurrence must be under the playhead in the current context. Walking
outward stops at the first valid symbol. A lane needs no cel at that frame,
but the occurrence chain that reaches the lane must still be valid. The empty
path always resolves to the open symbol.
Returns `{:kind :lane|:symbol :sid :path :frame :matrix :time}`."
[document store open selection frame]
(let [preferred (preferred-path document selection)]
(some (fn [path]
(when-let [inside (nest/inside document store open path frame)]
(when-let [sid (:sid inside)]
(assoc inside :path path
:kind (if (symbol/lane? (clip/symbol document sid))
:lane :symbol)))))
(take (inc (count preferred)) (iterate pop preferred)))))

9
frontend/src/arthur/events/footage.cljs
View file

@ -509,7 +509,10 @@
st (merge (:store entry) (:store built))
imported-frames (clip/output-frames clip sid)
source-fps (get-in built [:clip :fps])
where (ui/drop-destination db clip st frame target)
where (if point
(ui/creation-destination db clip st frame)
(ui/drop-destination db clip st frame target))
point (ui/destination-point where point)
result (if (:refused where)
where
(span/place-symbol (:clip where) st (:sid where)
@ -527,8 +530,8 @@
:source-inputs]))))]
{:db (-> db
(update :ui dissoc :convert)
(assoc-in [:ui :selection]
[:node (:sid where) uuid (conj (vec (:path where)) uuid)])
(ui/selected
[:node (:sid where) uuid (conj (vec (:path where)) uuid)])
(update :footage merge
{:loading? false
:status (str "made " name " · " imported-frames " frames at " fps " fps"

19
frontend/src/arthur/events/playback.cljs
View file

@ -44,6 +44,10 @@
:trace {:faces (trace/showing-for (:clip entry) sid #{})
:opacity (or (get-in db [:ui :trace :opacity])
trace/opacity-default)}})
;; Occurrence addresses belong to the document being left. Creation is
;; derived from the primary selection, so carrying one across documents
;; could otherwise make a coincidentally equal id a nested destination.
(update :ui dissoc :selection :selections :points)
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))))
@ -190,18 +194,13 @@
{:db (-> db
(update-in [:ui :tabs] #(if (some #{sid} %) % (conj (vec %) sid)))
(assoc-in [:ui :open] sid)
;; WHAT WAS SELECTED IS NOT IN HERE. A node selection and an
;; aimed target are paths in the symbol being left, and every
;; bar that reads one — the breadcrumb, the inspector, where a
;; new symbol would land — reads it against the open one. So
;; opening a symbol arrives with nothing selected, which is the
;; state the root crumb already means. A `[:symbol _]`
;; selection names a symbol rather than a place inside one and
;; survives.
;; A node address is relative to the tab being left. Opening a
;; symbol therefore arrives at its root; a pool `[:symbol _]`
;; selection is not an occurrence address and may survive.
(update :ui (fn [ui]
(cond-> (dissoc ui :target)
(cond-> ui
(= :node (first (:selection ui)))
(dissoc :selection))))
(dissoc :selection :selections))))
(update-in [:ui :trace :faces] #(trace/showing-for clip sid %))
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))

9
frontend/src/arthur/events/project.cljs
View file

@ -207,7 +207,10 @@
st (merge (:store entry) (:store other))
;; A symbol from another project arrives as an ordinary clip, the same
;; as one from this project's pool.
where (ui/drop-destination db clip st frame target)
where (if point
(ui/creation-destination db clip st frame)
(ui/drop-destination db clip st frame target))
point (ui/destination-point where point)
result (if (:refused where)
where
(span/place-symbol (:clip where) st (:sid where)
@ -217,8 +220,8 @@
(if-let [why (or (:refused where) (:refused result))]
{:db (update db :project merge {:status why})}
{:db (-> (edit/edit-entry db #(assoc % :clip (:clip result) :store st))
(assoc-in [:ui :selection]
[:node (:sid where) uuid (conj (vec (:path where)) uuid)])
(ui/selected
[:node (:sid where) uuid (conj (vec (:path where)) uuid)])
(update :project merge {:status (str "brought in " label)}))
:dispatch [::pb/refresh-clock]}))))

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

@ -1,19 +1,16 @@
(ns arthur.events.ui
"Selection, the TARGET, the active tone, the polygon being drawn, and which
timeline rows are open.
"Selection, the active tone, the polygon being drawn, and which timeline rows
are open.
TWO PIECES OF STATE AND NOT ONE. `[:ui :selection]` is what you are LOOKING
at — what the inspector shows, what the stage puts handles on. `[:ui :target]`
is where a new thing would GO. They used to be one, so clicking a shape on the
stage silently re-aimed the next polygon at whatever held it, which
`lane-model.md` forbids in so many words: \"Selection does not secretly change
where a new symbol goes.\"
THE CREATION TARGET IS A FUNCTION, NOT EDITOR STATE. The primary selection is
the preferred row, like the active layer in a paint program. The playhead
resolves that row to the nearest occurrence creation can happen in: an active
ordinary symbol, a lane insertion surface, an active ancestor, or the open
symbol. `docs/creating-in.md` is the contract.
THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label
or a breadcrumb is aiming — each names a place in the
document and nothing else. A click on the stage, or on a timeline bar, is not:
it says look at this. So `::select` never writes the target, and `::aim`
always writes both.
`[:ui :selections]` remains the set copied, deleted or transformed together;
`[:ui :selection]` is its primary member and therefore the creation anchor.
Moving the playhead never rewrites either one.
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
@ -22,11 +19,11 @@
[arthur.domain.clip :as clip]
[arthur.domain.clipboard :as clipboard]
[arthur.domain.correction :as correction]
[arthur.domain.creation :as creation]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]
[arthur.events.edit :as edit]
[arthur.domain.paint :as paint]
[arthur.events.playback :as playback]
@ -61,37 +58,17 @@
(update-in % [:symbols sid :nodes id] dissoc :name)))))))
(defn selected
"`db` with `selection` selected, and nothing aimed.
"`db` with `selection` as its primary active row.
Selection and row disclosure are independent. A click or trim can select a
nested item, but only the row's twist button opens or closes it."
[db selection]
;; A captured trim gesture also selects on pointer-up. It must not acquire the
;; unrelated side effect of opening every row above the edited clip.
(cond-> (-> db
(assoc-in [:ui :selection] selection)
(assoc-in [:ui :selections] (if selection [selection] []))
(update :ui dissoc :points :retry))
(nil? selection) (assoc-in [:ui :target] nil)))
(defn target-of
"The target `selection` names: `{:sid :id :path}`, or nil for the open symbol
itself.
All three parts, because a path alone cannot be looked up — one symbol placed
twice is two rows with the same node ids in them, so the row path says WHICH
and the sid says in which symbol's node map to find it. A selection made on
the stage carries no path; it names a node in the open symbol directly, and
the node's own id standing alone is that one-step path."
[selection]
(let [[kind sid id path] selection]
(when (and (= :node kind) id)
{:sid sid :id id :path (vec (or (seq path) [id]))})))
(defn aimed
"`db` with `selection` selected AND aimed: the target follows it."
[db selection]
(assoc-in (selected db selection) [:ui :target] (target-of selection)))
(-> db
(assoc-in [:ui :selection] selection)
(assoc-in [:ui :selections] (if selection [selection] []))
(update :ui dissoc :points :retry)))
(rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection)))
@ -118,34 +95,6 @@
(-> (selected db primary) (assoc-in [:ui :selections] xs))
(selected db nil)))))
(rf/reg-event-db
::toggle-and-aim
;; A modified timeline-label click has two independent meanings: membership in
;; the shared selection set, and the one place subsequent creation/paste uses.
(fn [db [_ selection]]
(let [primary (get-in db [:ui :selection])
many (vec (get-in db [:ui :selections]))
old (if (some #{primary} many) many (if primary [primary] []))
xs (if (some #{selection} old)
(vec (remove #{selection} old))
(conj old selection))
db (if-let [primary (peek xs)]
(-> (selected db primary) (assoc-in [:ui :selections] xs))
(selected db nil))]
(assoc-in db [:ui :target] (target-of selection)))))
(rf/reg-event-db
::aim
;; The gestures that name a PLACE in the document rather than a thing on
;; screen: a timeline row label or a breadcrumb.
(fn [db [_ selection]] (aimed db selection)))
(rf/reg-event-db
::aim-at
;; Aiming without selecting: the lane becomes where drawings go while the
;; inspector selection remains independent.
(fn [db [_ selection]] (assoc-in db [:ui :target] (target-of selection))))
(rf/reg-event-db
::set-tone
(fn [db [_ tone]] (assoc-in db [:ui :tone] tone)))
@ -450,42 +399,6 @@
(update-in db [:ui :smart] #(let [on? (boolean on)]
((if on? conj disj) (set %) face)))))
(defn where-new-goes
"The row path, from the open symbol down, of the symbol a new thing goes into:
INSIDE the aimed instance, or BESIDE an aimed node of any other kind, or at
the top of the open symbol when nothing is aimed.
READ OFF THE TARGET, NEVER THE SELECTION. The two were one thing, and the
result was that clicking a shape on the stage to look at it re-aimed the next
polygon at whatever happened to hold that shape. `[:ui :target]` is a row
path, because one symbol placed twice is two rows and only the path says which
one was aimed at."
[clip db]
(let [{:keys [sid id path]} (get-in db [:ui :target])]
(cond
(empty? path) []
(= :instance (get-in clip [:symbols sid :nodes id :kind])) path
:else (vec (butlast path)))))
(defn aimed-symbol
"The symbol a command acts in and the path of rows down to it: `{:sid :path}`.
INSIDE the aimed instance, beside an aimed node of any other kind, the open
symbol when nothing is aimed — which is `where-new-goes`, resolved. There is
no lane to aim at any more: a lane is how a symbol is DRAWN, so what a gesture
names is a symbol, and whether that symbol is drawn as a lane is a separate
question `symbol/lane?` answers."
[clip st db frame]
(let [open (get-in db [:ui :open])
down (where-new-goes clip db)
inside (nest/inside clip st open down frame)]
;; A stale or presently invisible target is no target. Creation must remain
;; a total operation, so it falls back to the document's main symbol.
(if (:sid inside)
(assoc inside :path down)
{:sid (if (get-in clip [:symbols :main]) :main open)
:path [] :frame frame})))
;; ---------------------------------------------------------------------------
;; clipboard and local duplication
@ -537,47 +450,11 @@
(edit/transaction (constantly (:clip r)))
(select-results []))))))))
(defn- apply-time [{:keys [at rate]} f]
(* rate (- f at)))
(defn paste-destination
"The aimed symbol, its row-path prefix, and the playhead in its frames.
Resolve the destination structurally. For an aimed instance, try the ordinary
visible walk first, then continue its authored clock beyond its span/window;
content outside the window is legal and is simply cropped by that window."
"The effective creation context at the playhead, in the destination's frames."
[db clip st]
(let [open (get-in db [:ui :open])
frame (editing-frame db clip)
{:keys [sid id path]} (get-in db [:ui :target])
n (when id (get-in clip [:symbols sid :nodes id]))
selection [:node sid id path]
owner-frame (when id (selection-frame clip st open selection frame))]
(cond
(nil? id)
{:sid open :path [] :frame frame}
(nil? n)
{:sid (if (get-in clip [:symbols :main]) :main open) :path [] :frame frame}
(= :instance (:kind n))
(let [visible (nest/inside clip st open path frame)
local (when (number? owner-frame) (node/local-frame n owner-frame))
shown (when (number? local) (clip/placed-frame clip sid n local))
mapped (when-let [t (and (number? owner-frame)
(clip/source-time clip sid n))]
(apply-time (node/then-time (node/time-of n) t) owner-frame))
held (when (zero? (:speed (node/playback-of n)))
(:in (node/playback-of n)))
at (or (:frame visible) (:frame shown) mapped held)]
(if (number? at)
{:sid (node/source n) :path (vec path) :frame (js/Math.floor at)}
{:sid (if (get-in clip [:symbols :main]) :main open) :path [] :frame frame}))
:else
(if (number? owner-frame)
{:sid sid :path (vec (butlast path)) :frame (js/Math.floor owner-frame)}
{:sid (if (get-in clip [:symbols :main]) :main open) :path [] :frame frame}))))
(creation/target clip st (get-in db [:ui :open])
(get-in db [:ui :selection]) (editing-frame db clip)))
(rf/reg-event-db
::paste
@ -633,59 +510,46 @@
(update-in db [:ui :draft] into [x y])
db)))
(defn into-the-sequence
"Where a polygon drawn into a symbol DRAWN AS A LANE goes: the path of the held
clip that symbol exposes at the playhead, and the document containing it.
`{:clip :path}`, or `{:refused why}`.
(defn new-lane-drawing
"Create the one-frame drawing cel implied by drawing with a lane row active.
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.
A lane is an insertion surface, so this always makes a new cel at the
playhead. Existing content at that frame is claimed and trimmed by
`overwrite-drawing`. Selecting an existing cel resolves to that cel's ordinary
source symbol before this function is reached, and therefore draws inside it.
`overwrite-drawing` rather than `append-drawing`, because a gap already has
the room. Appending RIPPLES everything after it later by the new clip's
duration — that is what `insert` means, and it is a different intention.
Placed into a gap, overwrite clears nothing and moves nobody.
THE CLIP'S PATH IS THE SYMBOL'S PATH PLUS ONE STEP, because a clip of a lane
is an ordinary row of the symbol holding it — which is the addressing `rows`
hands the timeline and `trail` reads back."
[clip db {:keys [sid frame path]}]
(let [exposed (when (integer? frame)
(some (fn [c] (let [[lo hi] (node/placed-span c)]
(when (and (<= lo frame) (< frame hi)) c)))
(symbol/children (get-in clip [:symbols sid :nodes]))))]
(cond
(not (integer? frame))
{:refused "the playhead is not on one frame of this symbol"}
exposed {:clip clip :sid sid :path (conj (vec path) (:id exposed))}
:else
(let [cel-id (random-uuid)
made (span/overwrite-drawing clip sid cel-id (clip/fresh-id clip) frame
{:extent :grow-symbol
:remainder-id (random-uuid)})]
(if (:refused made)
made
{:clip (:clip made) :sid sid :path (conj (vec path) cel-id)})))))
[clip {:keys [sid frame path]}]
(if-not (integer? frame)
{:refused "the playhead is not on one frame of this symbol"}
(let [cel-id (random-uuid)
made (span/overwrite-drawing clip sid cel-id (clip/fresh-id clip) frame
{:extent :grow-symbol
:remainder-id (random-uuid)})]
(if (:refused made)
made
{:clip (:clip made) :sid sid :path (conj (vec path) cel-id)}))))
(defn polygon-landing
"Choose the document and row path a finished polygon is drawn into.
WHERE IT GOES IS A SYMBOL, and what happens there follows how that symbol is
DRAWN: in one drawn as a lane an occupied frame lands in its clip and a gap
first becomes a one-frame drawing, because the sequence is what says which
drawing the playhead is on. In an ordinary composition the polygon goes
straight into the symbol, as it always did."
A resolved lane always gets a new drawing cel. A selected cel resolves to its
source symbol instead, so drawing there adds a child to that existing cel."
[clip st db]
(let [into (aimed-symbol clip st db (editing-frame db clip))]
(if (and (:sid into) (symbol/lane? (clip/symbol clip (:sid into))))
(assoc (into-the-sequence clip db into) :lane? true)
(let [into (creation/target clip st (get-in db [:ui :open])
(get-in db [:ui :selection]) (editing-frame db clip))]
(if (= :lane (:kind into))
(assoc (new-lane-drawing clip into) :lane? true)
{:clip clip :sid (:sid into) :path (:path into) :lane? false})))
(defn beginning-polygon
"Enter polygon mode, first materializing a drawing at the playhead when the
symbol it lands in is drawn as a lane and that frame is empty.
"Enter polygon mode, first materializing a new drawing at the playhead when
the effective target is a lane.
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
@ -708,8 +572,7 @@
;; left a selection that looked up to nothing, so the
;; inspector, the breadcrumb and every span command went
;; blank on a drawing that had just been created.
(assoc-in [:ui :selection]
[:node (:sid landing)
(selected [:node (:sid landing)
(peek (:path landing)) (:path landing)]))
:else db)]
@ -761,8 +624,8 @@
(-> db
(edit/transaction
(fn [_] (paint/new-shape source sid id frame pts (get-in db [:ui :tone]))))
(update :ui merge {:tool nil :draft []
:selection [:node sid id (conj down id)]})))))))
(update :ui merge {:tool nil :draft []})
(selected [:node sid id (conj down id)])))))))
(rf/reg-event-db
::set-knob
@ -783,21 +646,22 @@
"Create and place one empty symbol. Lane creation is explicit: `lane?` marks
the new symbol for linear timeline display; ordinary symbol creation never
does. Both operations place the new symbol through the same span command, so
an explicitly aimed lane still applies its claim-time rule."
a selected lane still applies its claim-time rule."
[db where lane?]
(let [{document :clip st :store} (store/entry (:clip/current db))
open (get-in db [:ui :open])
frame (editing-frame db document)
playhead (editing-frame db document)
into (if (= :top where)
(creation/target document st open nil playhead)
(creation/target document st open (get-in db [:ui :selection]) playhead))
;; A lane is the open symbol's timeline, not an insert that happens to
;; begin where the playhead was when it was made. Giving that wrapper
;; the whole open-symbol window makes the row's promise true: it is a
;; destination at every frame. Ordinary symbols remain clips created at
;; the playhead.
frame (if lane? 0 frame)
into (if (= :top where)
(assoc (nest/inside document st open [] frame) :path [])
(aimed-symbol document st db frame))
{host :sid at :frame down :path} into
;; its whole parent window makes the row's promise true: it is a
;; destination at every frame. Resolve the parent at the ACTUAL playhead
;; first; using frame zero for resolution would incorrectly fall out of
;; every nested symbol that begins later in the open context.
{host :sid resolved-at :frame down :path destination-kind :kind} into
at (if lane? 0 resolved-at)
sid (clip/fresh-id document)
instance-id (random-uuid)
end (clip/frames document host)
@ -811,7 +675,13 @@
:else
(let [new-symbol (cond-> {:id sid :name (name sid)
:fps (clip/fps document host)
:frames (- end at) :nodes {}}
;; A fresh cel is one frame for
;; frame-by-frame work. In an
;; ordinary composition the new
;; symbol keeps the available window.
:frames (if (= :lane destination-kind)
1 (- end at))
:nodes {}}
lane? (assoc :display :lane))
seeded (assoc-in document [:symbols sid] new-symbol)]
(span/place-symbol seeded st host instance-id sid at
@ -820,12 +690,11 @@
(if-let [why (:refused result)]
(update db :project merge {:status why})
(let [selection [:node host instance-id (conj (vec down) instance-id)]]
(cond-> (-> db
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] selection)
(update-in [:ui :expanded] (fnil into #{})
(rest (reductions conj [] down))))
lane? (assoc-in [:ui :target] (target-of selection)))))))
(-> db
(edit/transaction (constantly (:clip result)))
(selected selection)
(update-in [:ui :expanded] (fnil into #{})
(rest (reductions conj [] down))))))))
(rf/reg-event-db
::new-symbol
@ -835,11 +704,9 @@
(rf/reg-event-db
::new-lane
(fn [db _]
;; A lane is an explicit, persistent top-level track of the open symbol. It
;; must not become nested merely because the previously created lane is
;; still aimed, and it spans the open symbol rather than starting at the
;; current playhead.
(create-container db :top true)))
;; A lane is an explicit persistent row across the effective target symbol.
;; The playhead validates that nested target; the row itself begins at zero.
(create-container db :inside true)))
;; ---------------------------------------------------------------------------
;; a drop in flight
@ -875,31 +742,47 @@
pointer answered with — and `:at` is that frame carried down into the
destination's. Nothing on this path crosses the output grid.
`:clip` is handed back unchanged and is in the result only so the callers that
used to be given a document with a freshly made lane in it go on reading one
thing."
`:clip` is handed back unchanged so all placement callers consume the same
result shape."
[document st open frame target]
(let [target (if (vector? target)
(let [[_ sid id path] target]
{:sid sid :id id :path path})
target)
(let [[_ sid id selected-path] target
path0 (vec (or (seq selected-path) (when id [id])))
path (cond
(nil? target) []
(= :instance (get-in document [:symbols (:sid target)
:nodes (:id target) :kind]))
(vec (:path target))
:else (vec (butlast (:path target))))
{:keys [sid] at :frame} (nest/inside document st open path frame)]
(= :instance (get-in document [:symbols sid :nodes id :kind])) path0
:else (vec (butlast path0)))
{destination :sid at :frame matrix :matrix}
(nest/inside document st open path frame)]
(cond
(nil? sid) {:refused "what you are dropping into is not on screen at this frame"}
(nil? destination) {:refused "what you are dropping into is not on screen at this frame"}
(not (integer? at)) {:refused "the drop is not on one frame of that symbol"}
:else {:clip document :sid sid :at at :path path})))
:else {:clip document :sid destination :at at :path path :matrix matrix})))
(defn drop-destination
"`drop-destination-at` from the symbol currently open in `db`."
[db document st frame target]
(drop-destination-at document st (get-in db [:ui :open]) frame target))
(defn creation-destination
"A stage creation destination from the primary selection and playhead."
[db document st frame]
(let [{:keys [sid path matrix] at :frame}
(creation/target document st (get-in db [:ui :open])
(get-in db [:ui :selection]) frame)]
(cond
(nil? sid) {:refused "nothing under the playhead can contain this"}
(not (integer? at)) {:refused "the playhead is not on one frame of that symbol"}
:else {:clip document :sid sid :at at :path path :matrix matrix})))
(defn destination-point
"A point in the current tab transformed into `where`'s local coordinates."
[{:keys [matrix]} point]
(if-let [inv (and point matrix (node/invert matrix))]
(let [out (js/Float64Array. 2)]
(node/apply-pt! out 0 inv (first point) (second point))
[(aget out 0) (aget out 1)])
point))
(defn landed
"`db` after a drop that produced `result`, with `uuid` selected."
[db {:keys [sid path]} uuid result]
@ -908,7 +791,7 @@
(-> db
(update :ui dissoc :drop)
(edit/transaction (constantly (:clip result)))
(assoc-in [:ui :selection] [:node sid uuid (conj (vec path) uuid)]))))
(selected [:node sid uuid (conj (vec path) uuid)]))))
(rf/reg-event-db
::drop-symbol
@ -918,7 +801,10 @@
;; a lane trims its neighbour and a drop into a composition does not.
(fn [db [_ source-id frame point target]]
(let [{document :clip st :store} (store/entry (:clip/current db))
where (drop-destination db document st frame target)
where (if point
(creation-destination db document st frame)
(drop-destination db document st frame target))
point (destination-point where point)
uuid (random-uuid)]
(if (:refused where)
(-> db (update :ui dissoc :drop) (update :project merge {:status (:refused where)}))
@ -943,7 +829,7 @@
;; `place-sound` positions in. It used to be multiplied by the grid rate
;; again on the way in — a second conversion of an already-converted
;; number, which dropped a sound 2.5 frames late for every frame it was
;; aimed at in a 12fps project.
;; selected in a 12fps project.
(let [sid (:sid where)
seeded (clip/place-sound (:clip where) sid source label length rate
(:at where) uuid)]

1
frontend/src/arthur/flow/ingest.cljs
View file

@ -41,7 +41,6 @@
frames (js/Number (:frames m))
urls (:urls m)]
(when-not (and (js/Number.isFinite fps) (pos? fps)
(js/Number.isInteger frames) (<= 1 frames 900)
(string? (:audio m)) (seq (:audio m))
(sequential? urls) (every? string? urls))
(throw (ex-info "a footage manifest needs fps, frames (1–900), audio and a url per frame"

48
frontend/src/arthur/subs/ui.cljs
View file

@ -4,7 +4,8 @@
Cheap by construction, like `subs/playback`: each reads a path and returns a
value, so clicking a swatch notifies the swatches and nothing else."
(:require [arthur.domain.nest :as nest]
(:require [arthur.domain.creation :as creation]
[arthur.domain.nest :as nest]
[arthur.domain.pick :as pick]
[arthur.footage.store :as store]
[arthur.subs.playback :as playback]
@ -23,7 +24,6 @@
(cond (nil? primary) []
(some #{primary} many) many
:else [primary]))))
(rf/reg-sub ::target (fn [db _] (get-in db [:ui :target])))
(rf/reg-sub ::clipboard (fn [db _] (get-in db [:ui :clipboard])))
(rf/reg-sub ::retry (fn [db _] (get-in db [:ui :retry])))
(rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone])))
@ -67,33 +67,33 @@
(nest/inside clip st open (or path [id]) f)))))
(rf/reg-sub
::target-node
:<- [::target]
:<- [::render/clip]
(fn [[{:keys [sid id]} clip] _]
;; The node a new thing would be parented to, for the outline that says so.
;; `[sid id node]` as `::selected-node` gives it, so the two read alike.
(when (and clip id)
(when-let [n (get-in clip [:symbols sid :nodes id])]
[sid id n]))))
(rf/reg-sub
::target-placement
:<- [::target]
:<- [::target-node]
::creation-target
:<- [::selection]
:<- [::render/clip]
:<- [::render/clip-id]
:<- [::render/open]
:<- [::render/open-frame]
(fn [[{:keys [path]} [_ id n] clip clip-id open f] _]
;; `nest/placement` of the TARGET, with the bounds of what it draws — the
;; same work `::selected-placement` does, kept separate because the two are
;; separate states and are drawn differently: the target gets an outline and
;; a tag, the selection gets handles.
(when n
(fn [[selection clip clip-id open f] _]
(when clip
(creation/target clip (:store (store/entry clip-id)) open selection f))))
(rf/reg-sub
::creation-placement
:<- [::creation-target]
:<- [::render/clip]
:<- [::render/clip-id]
:<- [::render/open]
:<- [::render/open-frame]
(fn [[{:keys [path]} clip clip-id open f] _]
;; The effective occurrence whose contents receive creation. A fallback may
;; therefore outline an ancestor while the off-frame primary selection stays
;; unchanged.
(when (and clip (seq path))
(let [st (:store (store/entry clip-id))]
(when-let [pl (nest/placement clip st open (or path [id]) f)]
(assoc pl :node n :bounds ((pick/bounds-of clip st (:sid pl) n) (:frame pl))))))))
(when-let [{:keys [sid id frame] :as pl} (nest/placement clip st open path f)]
(let [n (get-in clip [:symbols sid :nodes id])]
(assoc pl :node n
:bounds ((pick/bounds-of clip st sid n) frame))))))))
(rf/reg-sub
::selected-placement

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

@ -119,7 +119,7 @@
(case kind
: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. The lane it was aimed at travels
;; the symbol they become is called. The explicit timeline row travels
;; with the question, so the answer lands where the drop pointed.
:footage (rf/dispatch [::footage/ask-convert c frame point target])
:import (rf/dispatch [::project/import c frame point target])

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

@ -141,12 +141,10 @@
last-i (dec (count crumbs))
shared (shared-with clip n)
says (whereabouts clip n inside)
;; WHAT IS AIMED, which is not what is selected: the menu has to name
;; the place it would add to, and that place is the target. Named the
;; way the trail names a crumb, so the menu and the outline's tag and
;; the breadcrumb all call one node by one name.
aimed (let [[tsid tid tn] @(rf/subscribe [::sub/target-node])]
(when tn (crumb-label clip tid tn)))]
;; The effective parent can be an active ancestor of the primary row
;; when the preferred occurrence is off the playhead.
destination (let [{:keys [id node]} @(rf/subscribe [::sub/creation-placement])]
(when node (crumb-label clip id node)))]
[:section.loc
[:nav.crumbs {:aria-label "editing location"}
(doall
@ -161,9 +159,7 @@
:title (if (zero? i)
"the open symbol — clear the selection"
(str label " · " (if lane? "lane" (name crumb-kind))))
;; A CRUMB AIMS, because this bar is the one that says where an
;; edit would land: going out to a level is going there to work.
:on-click #(rf/dispatch [::ui/aim (when (pos? i) select)])}
:on-click #(rf/dispatch [::ui/select (when (pos? i) select)])}
label]]))]
(when says
[:span.loc-fact {:title "the frame this selection is showing, in its own time"}
@ -184,20 +180,18 @@
[menu/view
{:label "new" :title "add to the document"
:items [{:label "inside"
:sub (if aimed
(str "a symbol in " aimed " — the outlined one")
:sub (if destination
(str "a symbol in " destination " — the outlined one")
(str "a symbol at the top of " (clip/symbol-name clip open)
", since nothing is aimed"))
", since no nested row is active here"))
:on-click #(rf/dispatch [::ui/new-symbol :inside])}
;; THE SECOND ITEM IS THE POINT OF THE MENU. With one item it was
;; impossible to add anything at the top of the open symbol
;; without first clearing the aim, which meant the only way out
;; of a nesting was to leave it — and nobody could see the rule
;; they were working against.
;; without first clearing the active row.
{:label "at top"
:disabled? (nil? aimed)
:disabled? (nil? destination)
:sub (str "a symbol straight into " (clip/symbol-name clip open)
", ignoring what is aimed")
", ignoring the active row")
:on-click #(rf/dispatch [::ui/new-symbol :top])}
{:label "lane"
:sub (str "a row for symbol clips in " (clip/symbol-name clip open))

35
frontend/src/arthur/ui/stage.cljs
View file

@ -140,15 +140,13 @@
(defn- select!
"Select the node at row path `path` of the open symbol — the selection a
timeline row makes, so the row, the inspector and the stage all show it — or
the open symbol itself when `path` is empty. Blank stage is an explicit place,
not merely an absence of a picked shape, so it clears a stale drawing target
as well as the inspector selection."
the open symbol itself when `path` is empty."
[{:keys [open f] :as ctx} path]
(let [{document :clip st :store} (loaded ctx)]
(if-let [{:keys [sid id]} (when (seq path)
(nest/placement document st open path f))]
(rf/dispatch [::ui/select [:node sid id path]])
(rf/dispatch [::ui/aim nil]))))
(rf/dispatch [::ui/select nil]))))
(defn- begin!
"Start dragging `kind` of the node at `path` from stage point `p`."
@ -305,13 +303,12 @@
(when-let [{:keys [sid id]} (and (seq path) (nest/placement document st open path f))]
[:node sid id path])))
(defn- aim-box
"The TARGET's outline: where a new polygon or symbol would be parented, drawn
around the thing that would be its parent.
(defn- creation-box
"The effective creation parent's outline, resolved from selection and playhead.
NOT THE SELECTION'S BOX AND DELIBERATELY NOT LIKE IT. The selection gets
handles, because handles are how you change it; the target gets an outline
with nothing to grab, because there is nothing to change about being aimed at.
with nothing to grab, because the derived destination is not itself a handle.
Same geometry — the node's bounds through its own transform, so it turns with
what it is around — and a different statement.
@ -323,8 +320,9 @@
carries a `viewBox` scaled by `zoom`, which is also why the stroke widths
nearby are fractions."
[]
(let [{:keys [world bounds]} @(rf/subscribe [::sub/target-placement])
[_ id n] @(rf/subscribe [::sub/target-node])
(let [{:keys [world bounds id node]}
@(rf/subscribe [::sub/creation-placement])
n node
label (or (:name n) (some-> (node/source n) name)
(when id (if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))]
(when (and world bounds)
@ -333,16 +331,16 @@
;; Furthest bottom-right of the four as drawn: the corner a reader
;; would call "the bottom right" whatever the node has been turned to.
[tx ty] (apply max-key (fn [[x y]] (+ x y)) corners)]
[:g.aim {:pointer-events "none"}
[:polygon.aim-box {:points (points-text (flatten corners))}]
[:g.creation-target {:pointer-events "none"}
[:polygon.creation-target-box {:points (points-text (flatten corners))}]
(when label
[:g {:transform (str "translate(" (+ tx 1.5) " " (+ ty 1.5) ")")}
;; The plate behind the text, sized off the string rather than
;; measured: `textLength` would need a layout pass, and a tag that
;; is a little wide is better than one that reflows the frame.
[:rect.aim-tag-bg {:x 0 :y 0 :rx 0.8
[:rect.creation-target-tag-bg {:x 0 :y 0 :rx 0.8
:width (+ 2 (* 2.1 (count label))) :height 5}]
[:text.aim-tag {:x 1 :y 3.8} label]])]))))
[:text.creation-target-tag {:x 1 :y 3.8} label]])]))))
(defn- overlay [w h zoom]
(let [tool @(rf/subscribe [::sub/tool])
@ -444,7 +442,7 @@
;; DRAWN WHILE DRAWING, unlike the handles. "Where will this polygon land"
;; is the question the outline exists to answer, and the moment it is being
;; asked is mid-draft.
(when-not points? [aim-box])
(when-not points? [creation-box])
(when-not (or drawing? points?)
(if (> (count placements) 1) [group-handles ctx placements] [handles ctx]))
(when (and id pts (not drawing?) (not (channel/nothing? pts)))
@ -475,12 +473,7 @@
;; unit a drop on the timeline's ruler lands in.
frame @(rf/subscribe [::render/open-frame])
clip @(rf/subscribe [::render/clip])
clip-id @(rf/subscribe [::render/clip-id])
db-target @(rf/subscribe [::sub/target])
open @(rf/subscribe [::render/open])
destination (when clip
(ui/aimed-symbol clip (:store (store/entry clip-id))
{:ui {:open open :target db-target}} frame))
destination @(rf/subscribe [::sub/creation-target])
destination-name (when-let [sid (:sid destination)]
(clip/symbol-name clip sid))
zoom @(rf/subscribe [::layout/zoom :stage])]

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

@ -585,14 +585,9 @@
(memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"}))))))
(defn- label-cell [{:keys [path depth label kind node-kind lane? select expandable? expanded? of via]}
selection selections target over solo tracing renaming draft]
selection selections target-path over solo tracing renaming draft]
(let [node? (= :node kind)
selected? (contains? selections select)
;; 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 []
@ -603,7 +598,7 @@
[over-path where] @over]
[:div (cond-> {:class (str "tl-label" (when (and select selected?) " on")
(when (and select (= select selection)) " primary")
(when aimed? " aimed")
(when (= path target-path) " target")
(when lane? " lane")
(when (= :ghost kind) " ghost")
(when (= path over-path)
@ -614,16 +609,13 @@
:style {:padding-left (str (+ 4 (* 11 depth)) "px")}
:title label
: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;
;; clicking its bar or one of its cels, below, says "show me
;; this", which is a statement about a thing on screen. Only
;; the first moves where new drawings and symbols go.
;; Labels, bars and stage objects all select the same row.
;; The primary row plus playhead resolves creation.
:on-click (fn [^js e]
(when select
(rf/dispatch [(if (.-shiftKey e)
::ui/toggle-and-aim
::ui/aim)
::ui/toggle-selection
::ui/select)
select])))
;; An instance's row opens the symbol it places, as a tab.
:on-double-click (fn [^js e]
@ -665,8 +657,10 @@
[:button.tl-twist
{:disabled (not expandable?)
:on-click (fn [^js e]
(println "heyyy")
(.stopPropagation e)
(rf/dispatch [::ui/toggle-row path]))}
(rf/dispatch [::ui/toggle-row path]))
:class (println expandable?)}
(when expandable? (if expanded? "▾" "▸"))]
;; A LANE IS NOT AN INSTANCE WEARING A DIFFERENT HAT, to read. Its one row
;; holds blocks that follow one another in time, where every other row
@ -726,7 +720,7 @@
moved since. 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 lane? of unmapped? owner]}
frames sliding hint {:keys [clip store open selection selections]}]
frames sliding hint {:keys [clip store open selection selections target-path]}]
(let [selected-set (set selections)
active-row (:row @sliding)
slide (fn [^js e]
@ -882,7 +876,8 @@
[:div.tl-track
;; The track, not the bar, holds the pointer while a bar slides, so the drag
;; goes on when the bar has slid off the ruler and is no longer drawn.
{:class (str (when lane? "lane") (when (= :palette kind) " palette"))
{:class (str (when lane? "lane") (when (= :palette kind) " palette")
(when (= path target-path) " target"))
:on-pointer-move slide
:on-pointer-up (fn [e] (slide e) (done true))
:on-pointer-cancel (fn [_] (done false))
@ -1000,6 +995,7 @@
:class (str (when ghost? "ghost")
(when (and select (contains? selected-set select)) " on")
(when (and select (= select selection)) " primary")
(when (= (nth select 3 nil) target-path) " target")
(when (and select (= select (get-in @sliding [:nest :select])))
" nest-target"))
:style {:position "absolute" :left (edge% in frames)
@ -1107,7 +1103,12 @@
selection @(rf/subscribe [::sub/selection])
selections @(rf/subscribe [::sub/selections])
selection-set (set selections)
target @(rf/subscribe [::sub/target])
creation @(rf/subscribe [::sub/creation-target])
target-path (let [path (:path creation)]
(if (and (empty? path)
(= :lane (:kind creation)))
[::lane]
path))
expanded @(rf/subscribe [::sub/expanded])
drop @(rf/subscribe [::sub/drop])
solo (set @(rf/subscribe [::render/solo]))
@ -1123,7 +1124,7 @@
;; will resolve on release -- and with no row under the pointer it is a
;; row of its own at the top of the section it will appear in.
;;
;; A SOUND USED TO BE THE EXCEPTION: aimed at a lane it drew no block
;; A SOUND USED TO BE THE EXCEPTION: over a lane it drew no block
;; there and a ghost row down in the audio section instead, so dragging
;; a sound onto a lane looked exactly like a lane refusing it -- while
;; the drop itself worked and put the sound in the lane. One rule
@ -1175,18 +1176,16 @@
[:section.pane.time
[transport]
[:div.tl-body
;; Blank timeline space means the open symbol. Use the same `aim`
;; gesture as its breadcrumb so both the visible selection and the
;; drawing destination return to the root. Child controls stop their
;; Blank timeline space means the open symbol. Child controls stop their
;; own events; the target check keeps ordinary row/bar clicks local.
{:on-click (fn [^js e]
(when (= (.-target e) (.-currentTarget e))
(rf/dispatch [::ui/aim nil])))}
(rf/dispatch [::ui/select nil])))}
[:div.tl-labels
;; Empty label space takes a row back out to the top of the open symbol.
{:on-click (fn [^js e]
(when (= (.-target e) (.-currentTarget e))
(rf/dispatch [::ui/aim nil])))
(rf/dispatch [::ui/select nil])))
:on-drag-over (fn [^js e]
(when (drag/row)
(.preventDefault e)
@ -1202,12 +1201,13 @@
(doall (for [row visible]
(with-meta (if (= :section (:kind row))
[:div.tl-label.tl-section (:label row)]
[label-cell row selection selection-set target over solo tracing renaming draft])
[label-cell row selection selection-set target-path
over solo tracing renaming draft])
{:key (str (:path row))})))]
[:div.tl-tracks
{:on-click (fn [^js e]
(when (= (.-target e) (.-currentTarget e))
(rf/dispatch [::ui/aim nil])))
(rf/dispatch [::ui/select nil])))
:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
:on-drag-over (fn [^js e]
(when (drag/accepts?)
@ -1265,7 +1265,8 @@
[:div.tl-track.tl-section]
[track-cell row frames sliding hint
{:clip clip :store store :open open
:selection selection :selections selections}])
:selection selection :selections selections
:target-path target-path}])
{:key (str (:path row))})))
[:div.tl-empty "nothing in this symbol"])
[playhead :div.tl-playhead frames]]]

4
frontend/src/arthur/ui/topbar.cljs
View file

@ -78,9 +78,9 @@
:disabled? (not selected?) :on-click #(rf/dispatch [::ui/copy])}
{:label "cut" :sub "Cut selection · ⌘/Ctrl X"
:disabled? (not selected?) :on-click #(rf/dispatch [::ui/cut])}
{:label "paste" :sub "Paste at playhead into the aimed place · ⌘/Ctrl V"
{:label "paste" :sub "Paste at playhead into the active row · ⌘/Ctrl V"
:disabled? (nil? clipboard) :on-click #(rf/dispatch [::ui/paste])}
{:label "duplicate" :sub "Duplicate here; lanes repeat forward · ⌘/Ctrl D"
{:label "duplicate" :sub "Duplicate beside selection; lanes repeat forward · ⌘/Ctrl D"
:disabled? (not selected?) :on-click #(rf/dispatch [::ui/duplicate])}
{:label "duplicate unique"
:sub "Duplicate with a private nested symbol graph · ⇧⌘/Ctrl D"

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

@ -51,6 +51,52 @@
(is (= [4 8] (node/placed-span (get-in made [:symbols :main :nodes id]))))
(is (empty? (clip/problems made)))))
(deftest multi-paste-has-one-destination-and-preserves-root-timing
(let [doc (update-in (fixture/document) [:symbols :main] dissoc :display)
payload (:clipboard
(clipboard/snapshot doc [(address :main :a [:a])
(address :main :b [:b])]))
r (clipboard/paste doc payload :main 20 {:fresh-id (ids)})
made (:clip r)
[a2 b2] (:roots r)]
(is (= [20 24] (node/placed-span (get-in made [:symbols :main :nodes a2]))))
(is (= [24 28] (node/placed-span (get-in made [:symbols :main :nodes b2]))))
(is (= 2 (count (:roots r))))
(is (empty? (clip/problems made)))))
(deftest multi-paste-into-a-lane-claims-all-intervals-atomically
(let [doc (fixture/document)
payload (:clipboard
(clipboard/snapshot doc [(address :main :a [:a])
(address :main :insert [:insert])]))
r (clipboard/paste doc payload :main 4 {:fresh-id (ids)})
made (:clip r)
[a2 insert2] (:roots r)]
(is (= [4 8] (node/placed-span (get-in made [:symbols :main :nodes a2]))))
(is (= [12 16] (node/placed-span (get-in made [:symbols :main :nodes insert2]))))
(is (nil? (get-in made [:symbols :main :nodes :b])))
(is (= [8 12] (node/placed-span (get-in made [:symbols :main :nodes :insert]))))
(is (= 16 (get-in made [:symbols :main :frames])))
(is (empty? (clip/problems made)))))
(deftest overlapping-multi-paste-into-a-lane-is-all-or-nothing
(let [base (fixture/document)
doc (-> base
(assoc-in [:symbols :source]
{:id :source :frames 8
:nodes {:a (get-in base [:symbols :main :nodes :a])
:b (assoc-in (get-in base [:symbols :main :nodes :b])
[:time :at] 2)}})
(assoc-in [:symbols :empty-lane]
{:id :empty-lane :frames 8 :display :lane :nodes {}}))
payload (:clipboard
(clipboard/snapshot doc [(address :source :a [:a])
(address :source :b [:b])]))
r (clipboard/paste doc payload :empty-lane 0 {:fresh-id (ids)})]
(is (= "overlapping copied things cannot be pasted into one lane" (:refused r)))
(is (nil? (:clip r)))
(is (= {} (get-in doc [:symbols :empty-lane :nodes])))))
(deftest lane-duplicate-is-the-forward-repeat-and-ripples-later-cels
(let [doc (fixture/document)
payload (:clipboard

164
frontend/test/arthur/events/lane_test.cljs
View file

@ -1,6 +1,7 @@
(ns arthur.events.lane-test
(:require [cljs.test :refer [deftest is]]
[arthur.domain.clip :as clip]
[arthur.domain.creation :as creation]
[arthur.domain.history :as history]
[arthur.domain.leaf :as leaf]
[arthur.domain.node :as node]
@ -42,22 +43,61 @@
(node/placed-span (get-in fitted [:symbols :main :nodes instance-id])))
"the lane follows a later change to its parent's extent")
(is (= 300 (clip/frames fitted lane-id))))
(is (some? (get-in lane-db [:ui :target]))
"the new lane is aimed so drawing and pool drops can go into it"))))
(is (= :lane (:kind (creation/target document {} :main
(get-in lane-db [:ui :selection]) 6)))
"the new lane is the active creation row"))))
(deftest aiming-the-root-clears-selection-and-drawing-target
(deftest a-new-symbol-on-a-lane-is-a-one-frame-cel
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "one-frame-new-symbol")]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main
:selection [:node :main nil []]}
:playback {:frame 5}})
(rf/dispatch-sync [::ui/new-symbol :inside])
(let [db @rf-db/app-db
saved (:clip (store/entry id))
[_ sid instance-id] (get-in db [:ui :selection])
instance (get-in saved [:symbols sid :nodes instance-id])
source (node/source instance)]
(is (= :main sid))
(is (= [5 6] (node/placed-span instance)))
(is (= 1 (clip/frames saved source)))
(is (every? (fn [other]
(or (= instance-id (:id other))
(let [[a b] (node/placed-span other)]
(or (<= b 5) (<= 6 a)))))
(filter node/placed-span
(vals (get-in saved [:symbols :main :nodes]))))
"claiming the frame leaves no overlapping cel"))))
(deftest a-new-lane-uses-the-symbol-selected-at-the-playhead
(let [doc (clip/blank)
id (store/install! {:clip doc :store {}} "nested-new-lane")]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main} :playback {:frame 6}})
(rf/dispatch-sync [::ui/new-symbol :inside])
(let [parent-instance (nth (get-in @rf-db/app-db [:ui :selection]) 2)
parent-sid (node/source (get-in (:clip (store/entry id))
[:symbols :main :nodes parent-instance]))]
(rf/dispatch-sync [::ui/new-lane])
(let [db @rf-db/app-db
saved (:clip (store/entry id))
[_ host lane-instance] (get-in db [:ui :selection])
lane-sid (node/source (get-in saved [:symbols host :nodes lane-instance]))]
(is (= parent-sid host) "the lane is created inside the selected symbol")
(is (= :lane (get-in saved [:symbols lane-sid :display])))
(is (= [0 (clip/frames saved host)]
(node/placed-span (get-in saved [:symbols host :nodes lane-instance]))))
(is (nil? (get-in saved [:symbols :main :nodes lane-instance]))
"it does not bypass the target and land in the tab root")))))
(deftest selecting-the-root-clears-the-active-row
(let [db {:ui {:selection [:node :main :shape [:lane :shape]]
:target {:sid :main :id :lane :path [:lane]}}}
after (ui/aimed db nil)]
(is (nil? (get-in after [:ui :selection])))
(is (nil? (get-in after [:ui :target])))))
(deftest clearing-selection-also-clears-the-creation-target
(let [db {:ui {:selection [:symbol :drawing]
:target {:sid :main :id :lane :path [:lane]}}}
:selections [[:node :main :shape [:lane :shape]]]}}
after (ui/selected db nil)]
(is (nil? (get-in after [:ui :selection])))
(is (nil? (get-in after [:ui :target])))))
(is (empty? (get-in after [:ui :selections])))))
(deftest an-explicit-lane-is-one-row-of-clips
(let [doc (fixture/document)
@ -111,7 +151,34 @@
(is (= 12 (ui/selection-frame doc nil :main
[:node :main :a [:a]] 12)))))
(deftest paste-targeting-continues-an-instance-clock-past-its-window
(deftest creation-walks-to-the-nearest-valid-parent-at-the-playhead
(let [doc (-> (fixture/document)
(assoc-in [:symbols :shot]
{:id :shot :frames 12 :fps 24
:nodes {:girl {:id :girl :kind :instance :z "a"
:span [0 12] :time {:mode :map :at 0 :rate 1}
:source {:symbol :main}
:playback {:in 0 :speed 1 :end :stop}}}})
(assoc-in [:symbols :outer]
{:id :outer :frames 30 :fps 24
:nodes {:take {:id :take :kind :instance :z "a"
:span [0 12] :time {:mode :map :at 10 :rate 1}
:source {:symbol :shot}
:playback {:in 0 :speed 1 :end :stop}}}}))
selection [:node :main :a [:take :girl :a]]
at #(select-keys (creation/target doc nil :outer selection %)
[:kind :sid :path :frame])]
(is (= {:kind :symbol :sid :drawing-a :path [:take :girl :a] :frame 0}
(at 12))
"the selected cel is the parent while every enclosing occurrence is active")
(is (= {:kind :lane :sid :main :path [:take :girl] :frame 5}
(at 15))
"past the cel, its containing lane is the nearest valid insertion surface")
(is (= {:kind :symbol :sid :outer :path [] :frame 25}
(at 25))
"a lane behind an inactive parent occurrence is not valid")))
(deftest creation-walks-out-of-an-instance-past-its-window
(let [doc {:fps 24 :width 20 :height 20
:symbols
{:main {:id :main :frames 40
@ -121,16 +188,40 @@
:playback {:in 0 :speed 1 :end :stop}}}}
:inside {:id :inside :frames 10 :nodes {}}}}
db {:ui {:open :main
:target {:sid :main :id :drawing :path [:drawing]}}
:selection [:node :main :drawing [:drawing]]}
:playback {:frame 20}}]
(is (= {:sid :inside :path [:drawing] :frame 20}
(ui/paste-destination db doc nil))
"pasting outside a target symbol's window authors cropped content")))
(is (= {:sid :main :path [] :frame 20}
(select-keys (ui/paste-destination db doc nil) [:sid :path :frame]))
"an inactive selected symbol falls back to the open symbol")))
(deftest multi-paste-uses-one-current-primary-target-and-selects-the-batch
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "multi-paste-target")
a [:node :main :a [:a]]
insert [:node :main :insert [:insert]]]
(reset! rf-db/app-db {:clip/current id :paint/revision 0
:ui {:open :main :selection insert :selections [a insert]}
:playback {:frame 4}})
(rf/dispatch-sync [::ui/copy])
;; Changing selection after copy changes the destination, not the payload.
(rf/dispatch-sync [::ui/select [:node :main nil []]])
(rf/dispatch-sync [::ui/paste])
(let [db @rf-db/app-db
saved (:clip (store/entry id))
selections (get-in db [:ui :selections])
[a2 insert2] (map #(nth % 2) selections)]
(is (= 2 (count selections)))
(is (= (peek selections) (get-in db [:ui :selection]))
"the last pasted root is the new primary creation anchor")
(is (= [4 8] (node/placed-span (get-in saved [:symbols :main :nodes a2]))))
(is (= [12 16] (node/placed-span (get-in saved [:symbols :main :nodes insert2]))))
(is (= 1 (count (get-in (store/entry id) [:history :done])))
"the complete batch is one edit"))))
(deftest polygon-landing-obeys-the-destination-symbol-mode
(let [lane (fixture/document)
ordinary (update-in lane [:symbols :main] dissoc :display)
db {:ui {:open :main :target {:sid :main :id :plate :path [:plate]}}
db {:ui {:open :main :selection [:node :main :plate [:plate]]}
:playback {:frame 5}}]
(is (true? (:lane? (ui/polygon-landing lane {} db))))
(is (false? (:lane? (ui/polygon-landing ordinary {} db))))))
@ -148,6 +239,21 @@
(is (nil? (get-in saved [:symbols :main :display])))
(is (nil? (get-in (store/entry (:clip/current after)) [:history :done])))))
(deftest drawing-with-the-lane-row-active-creates-a-new-cel
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "draw-new-lane-cel")
db {:clip/current id :paint/revision 0
:ui {:open :main :selection [:node :main nil []]}
:playback {:frame 1}}
after (ui/beginning-polygon db)
[_ sid cel-id] (get-in after [:ui :selection])
saved (:clip (store/entry id))]
(is (= :main sid))
(is (not= :a cel-id) "the occupied cel is not reused")
(is (= [1 2] (node/placed-span (get-in saved [:symbols sid :nodes cel-id]))))
(is (= 1 (clip/frames saved (node/source (get-in saved [:symbols sid :nodes cel-id])))))
(is (= :polygon (get-in after [:ui :tool])))))
(deftest sequence-commands-use-isolated-history-transactions
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "sequence-command-test")
@ -184,24 +290,22 @@
(is (= [:vo] (mapv :id (:cels lane))))
(is (empty? (timeline/sound-rows doc :main #{})))))
(deftest aiming-the-open-lanes-own-row-is-a-selection-and-not-a-crash
(deftest selecting-the-open-lanes-own-row-is-the-lane-target
;; `rows` names the open symbol's own lane row `[:node sid nil []]`, and
;; `selected` used to open the rows above a selection with `(pop path)` —
;; which THROWS on `[]`, aborting the whole event. Nothing was selected,
;; nothing was aimed, and the next polygon went wherever the stale target
;; still pointed, which is most of what made aiming a lane feel random.
;; nothing was selected, and the next polygon used stale creation state.
(let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "aim-the-open-lane")
id (store/install! {:clip doc :store {}} "select-the-open-lane")
db {:clip/current id :paint/revision 0
:ui {:open :main :target {:sid :main :id :a :path [:a]}}
:ui {:open :main}
:playback {:frame 0}}
lane (first (filter :lane? (timeline/rows doc :main #{})))
after (ui/aimed db (:select lane))]
after (ui/selected db (:select lane))]
(is (= [:node :main nil []] (:select lane)))
(is (= [:node :main nil []] (get-in after [:ui :selection])))
(is (nil? (get-in after [:ui :target]))
"the open symbol IS the place, so aiming its own row clears the target")
(is (= [] (ui/where-new-goes doc after)))
(is (= :lane (:kind (creation/target doc {} :main
(get-in after [:ui :selection]) 0))))
(is (empty? (get-in after [:ui :expanded]))
"and there are no rows above the top to open")))
@ -229,7 +333,7 @@
id (store/install! {:clip doc :store {}} "finish-opens-nothing")
db {:clip/current id :paint/revision 0
:ui {:open :main :tool :polygon
:target {:sid :main :id :a :path [:a]}
:selection [:node :main :a [:a]]
:draft [10 10 40 10 40 40]}
:playback {:frame 1}}]
(reset! rf-db/app-db db)
@ -237,7 +341,7 @@
(let [after @rf-db/app-db
[kind sid shape-id path] (get-in after [:ui :selection])]
(is (= :node kind))
(is (= :drawing-a sid) "the shape went into the drawing the aimed clip places")
(is (= :drawing-a sid) "the shape went into the drawing the selected clip places")
(is (= [:a shape-id] path))
(is (empty? (get-in after [:ui :expanded])))
(is (nil? (get-in after [:ui :tool]))))))
@ -260,7 +364,7 @@
:playback {:in 0 :speed 1 :end :stop}}}}))
id (store/install! {:clip doc :store {}} "clip-selected-where-it-lives")
db {:clip/current id :paint/revision 0
:ui {:open :shot :target {:sid :shot :id :girl :path [:girl]}}
:ui {:open :shot :selection [:node :shot :girl [:girl]]}
:playback {:frame 9}}
after (ui/beginning-polygon db)
[_ sid clip-id path] (get-in after [:ui :selection])

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

@ -120,6 +120,11 @@ try {
assert.equal(await evaluate('document.querySelectorAll(".tl-track:not(.palette)").length'), 1,
'an ordinary symbol is an ordinary timeline row');
// The new symbol is now the active creation parent. Return to the tab root
// to ask for a sibling lane in `main`; leaving it selected would correctly
// create the lane inside that symbol.
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(
cljs.core.keyword('arthur.events.ui/select'), null))`);
await clickNew('lane');
s = await shot();
placed = mainInstances(s);
@ -178,8 +183,11 @@ try {
`the dropped clip remains in the explicit lane: ${JSON.stringify(s)}`);
assert.equal(laneSymbols(s).length, 1, 'the drop creates no extra lane');
// A second explicit lane is a sibling in the open symbol even though the
// first remains aimed. Move the clip between their linear tracks.
// Return to the root active row, then make a sibling lane there. Lane
// creation follows the selected target; the unit suite separately asserts
// that leaving a symbol selected creates the lane inside that symbol.
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(
cljs.core.keyword('arthur.events.ui/select'), null))`);
await clickNew('lane');
s = await shot();
assert.equal(laneSymbols(s).length, 2, 'a second explicit command creates a second lane');
@ -239,7 +247,7 @@ try {
await shortcut('z', 'KeyZ');
assert.equal(mainInstances(await shot()).length, 2, 'one undo restores the cut');
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(
cljs.core.keyword('arthur.events.ui/aim'), null))`);
cljs.core.keyword('arthur.events.ui/select'), null))`);
await sleep(80);
await shortcut('v', 'KeyV');
assert.equal(mainInstances(await shot()).length, 3, 'paste uses the copied snapshot');

13
frontend/test/browser/take.mjs
View file

@ -501,6 +501,17 @@ async function main() {
// the authored node, the raster preview and the document round trip.
await page.eval(SEEK(0));
await sleep(150);
// A lane row means "new one-frame cel". This test authors drawing keys
// across the existing take, so make that cel the active row first; creation
// then enters the symbol it places, exactly as a person clicking its block.
await page.eval(`(() => {
const cel = document.querySelector('.tl-cel');
if (!cel?.arthurCel?.select) return false;
re_frame.core.dispatch_sync(cljs.core.vector(
cljs.core.keyword('arthur.events.ui/select'), cel.arthurCel.select));
return true;
})()`);
await sleep(150);
const beforePaint = await page.eval(`(() => {
const c = document.querySelector('canvas.stage');
const d = c.getContext('2d').getImageData(25, 20, 1, 1).data;
@ -513,7 +524,7 @@ async function main() {
// A person cannot click twice inside one microtask; a test should not either.
const armed = await page.eval(`(() => {
const button = [...document.querySelectorAll('.palette-bar button')]
.find(b => b.textContent === 'polygon');
.find(b => b.textContent === 'pen');
if (!button) return false;
button.click();
return true;