Add multi-selection clipboard commands

This commit is contained in:
Your Name 2026-10-02 16:13:03 -04:00
parent 987e289f89
commit edca82cd5d
10 changed files with 839 additions and 36 deletions

139
docs/clipboard-plan.md Normal file
View file

@ -0,0 +1,139 @@
# Selection and clipboard
This is the implementation contract for multi-selection, copy, cut, paste,
duplicate, and duplicate unique. It deliberately replaces any incidental older
behavior. The document model is the authority; the stage and timeline are two
views of the same editor state.
## One selection
`[:ui :selections]` is the ordered selection set. Its last member is the primary
selection in `[:ui :selection]`, used by the inspector and single-subject tools.
Every member is an occurrence address:
```clojure
[:node owner-symbol-id node-id row-path]
```
The row path distinguishes two occurrences of shared content. Commands that
write the document canonicalize those addresses before acting:
- invalid and non-node addresses are ignored;
- the same owned node, `[owner-symbol-id node-id]`, is acted on once;
- when one selected row path is below another selected row path, only the
ancestor is a clipboard root. Its ordinary parent-pointer subtree comes with
it, and an instance already displays the symbol it references, so also
materializing the visibly nested selection would duplicate it twice.
Plain click replaces the selection. Shift-click toggles membership, on both the
stage and timeline. A stage marquee replaces, or with Shift adds to, the same
set. Timeline rows, bars, and cel blocks render membership from that same set;
the primary member gets the inspector/focus treatment.
Targeting remains separate. Clicking a timeline label both selects it and aims
it. Shift-click changes the selection set and makes the clicked row the one
target. Clicking a bar/cel or the stage changes selection without silently
changing the target. A target is singular even when selection is plural.
## Clipboard value
The clipboard is editor state, not document state and not history. Copy records
a detached snapshot of each canonical root and its complete parent-pointer
subtree. It records source occurrence paths and authored node data, but normal
copy deliberately keeps referenced symbol identities. Therefore a pasted
instance is another use of the same symbol. The clipboard survives cutting its
nodes because it contains the node snapshot, not merely their addresses.
This first implementation is the application's clipboard, not the operating
system clipboard. It is consequently project-local and has no serialization or
cross-project identity collision policy hidden inside it.
## Paste
Paste always uses the explicit insertion target and the playhead:
- no target: paste at the top of the open symbol;
- aimed ordinary node: paste beside it in the symbol that owns it;
- aimed instance, including an instance whose source is drawn as a lane: paste
inside the symbol it places;
- the open lane's own row: paste directly into that lane.
The destination is resolved structurally from the target. It does not require
the target instance to be visible at the playhead. Being outside the target
symbol's authored window is legal: content can exist there and be cropped by
the window. Lane paste may grow the lane/window because a sequence cannot store
an overlapping or unreachable tail and pretend the edit succeeded.
The earliest finite start among the copied roots is aligned with the playhead
in the destination. All other root starts retain their offset from it. Roots
without a finite span remain timeless; paste does not invent a span for a shape
that was authored for the whole symbol. Parent/child timing, transforms,
channels, corrections, playback, stencil links, and relative root order are
otherwise copied exactly. Every node receives a new identity, and all internal
parent and stencil references are remapped.
In an ordinary composition overlap is valid. In a lane the pasted finite spans
claim their intervals using the lane's existing overwrite rule: covered cels
are removed, crossing cels are trimmed or split, and the pasted roots do not
overlap one another. Pasting a timeless root into a lane is refused. Validation
is all-or-nothing.
After paste, the new roots are the selection, in clipboard order, and the last
one is primary.
## Cut
Cut first takes exactly the same snapshot as copy, then deletes every canonical
root and its parent-pointer subtree. The clipboard write is editor state; the
whole document deletion is one history transaction. The selection is cleared.
Undo restores the deleted document nodes. It does not roll back the clipboard,
which matches ordinary editor behavior.
## Duplicate and Duplicate Unique
Duplicate does not read the insertion target or playhead. It is a local
operation beside the selected material:
- in an ordinary composition, copies keep the originals' parent, transform,
timing, and span, and are stacked immediately in front;
- for direct children of a lane, the selected temporal envelope is repeated
immediately after itself. Relative timing and gaps inside the selected set are
preserved, and later cels ripple forward by the envelope duration. This is
the lane's useful "duplicate forward" behavior; it is not a second command.
Selections in several owners are handled per owner in one command. Thus two
lane selections repeat in their respective lanes, while a selected composition
node duplicates in place, all as one history step.
Normal Duplicate preserves symbol references, just like normal copy/paste.
Duplicate Unique performs the same placement but deep-copies the complete graph
of every referenced symbol. One shared remap table is used for the whole batch,
so two duplicated instances that shared a nested part still share one new copy
with each other, while sharing nothing mutable with the originals. Immutable
media/store blocks may remain shared.
After either duplicate command, the new roots replace the selection.
## History, refusal, and stale state
Cut, paste, duplicate, and duplicate unique each call one domain command and
commit through one `edit/transaction`; each is exactly one undo/redo step no
matter how many nodes or symbols it touches. Copy, aiming, and selection do not
touch history. A refusal changes no document leaves and creates no history step.
Undo/redo filters the complete selection set against the restored document and
repairs the primary selection. Clipboard payloads remain snapshots. Paste
validates the destination and all remapped references at commit time, so a stale
target or a newly impossible symbol cycle refuses rather than partially editing.
## Required tests
Domain tests cover canonical ancestor/descendant selection, subtree ID remaps,
normal shared references, deep unique graph remaps, multi-root relative timing,
composition overlap, lane overwrite, lane forward duplication and ripple,
mixed-owner duplication, cycle refusal, stale targets, and all-or-nothing
failure. Event tests cover copy without history, atomic cut/paste/duplicates,
resulting multi-selection, target resolution, pasting beyond a symbol window,
and one undo plus redo of each mutation. Browser tests cover mirrored stage and
timeline selection, Shift-toggle on labels/bars/cels, singular aiming, and the
keyboard commands.

View file

@ -0,0 +1,287 @@
(ns arthur.domain.clipboard
"Pure multi-node clipboard commands.
A clipboard value is a detached forest of node maps. Normal copies keep symbol
references; `duplicate` with `:unique?` copies the complete referenced symbol
graph once for the whole forest. UI state, playhead conversion, and history
stay in events.ui. See docs/clipboard-plan.md."
(:require [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]))
(defn- prefix? [a b]
(and (<= (count a) (count b)) (= a (subvec b 0 (count a)))))
(defn- node-selections [clip selections]
(->> selections
(keep (fn [[kind sid id path :as address]]
(when (and (= :node kind) id (get-in clip [:symbols sid :nodes id]))
{:address address :sid sid :id id :path (vec (or path [id]))})))
;; One owned node reached through two shared occurrences is still one edit.
(reduce (fn [{:keys [seen out] :as acc} {:keys [sid id] :as x}]
(if (contains? seen [sid id]) acc
{:seen (conj seen [sid id]) :out (conj out x)}))
{:seen #{} :out []})
:out))
(defn canonical
"Valid selected node occurrences, with anything visibly below another selected
occurrence omitted. Order is selection order and therefore keeps the primary
member last in the ordinary case."
[clip selections]
(let [xs (node-selections clip selections)]
(filterv (fn [{p :path}]
(not-any? (fn [{q :path}]
(and (< (count q) (count p)) (prefix? q p)))
xs))
xs)))
(defn- subtree [nodes root]
(into {} (filter (fn [[id _]] (some #{root} (symbol/lineage nodes id)))) nodes))
(defn snapshot
"Snapshot the canonical selected forest, or `{:refused why}`."
[clip selections]
(let [roots (canonical clip selections)]
(if (empty? roots)
{:refused "select something to copy"}
{:clipboard
{:items
(mapv (fn [{:keys [sid id path]}]
(let [nodes (get-in clip [:symbols sid :nodes])]
{:sid sid :root id :path path :parent (:parent (get nodes id))
:nodes (subtree nodes id)}))
roots)}})))
(defn cut
"Delete a previously snapshotted forest. Snapshotting first is what makes cut
retain data even though its source nodes are gone."
[clip {:keys [items]}]
(let [after (reduce (fn [c {:keys [sid root]}] (nest/delete-node c sid root)) clip items)]
(if-let [why (first (clip/problems after))]
{:refused why}
{:clip after :selections []})))
(defn- fresh
[taken fresh-id]
(loop [id (fresh-id)]
(if (contains? taken id) (recur (fresh-id)) id)))
(defn- allocate
[clip items fresh-id]
(loop [pending (vec (mapcat (fn [[i item]] (map #(vector i %) (keys (:nodes item))))
(map-indexed vector items)))
taken (into #{} (mapcat (comp keys :nodes val) (:symbols clip)))
ids {}]
(if-let [k (first pending)]
(let [id (fresh taken fresh-id)]
(recur (subvec pending 1) (conj taken id) (assoc ids k id)))
ids)))
(defn- unique-content
[clip items unique?]
(let [roots (into #{} (comp (mapcat #(vals (:nodes %))) (keep node/source)) items)]
(if (and unique? (seq roots))
(let [{c :clip ids :ids} (bring/symbols clip clip roots {})]
[c ids])
[clip {}])))
(defn- materialize
[clip items fresh-id unique? paste?]
(let [[clip source-ids] (unique-content clip items unique?)
ids (allocate clip items fresh-id)
made
(mapv
(fn [[i {:keys [sid root path parent nodes]}]]
(let [id-of #(get ids [i %])
copied (into {}
(map (fn [[old n]]
(let [id (id-of old)]
[id (cond-> (assoc n :id id)
(:parent n) (assoc :parent (id-of (:parent n)))
(:stencil n) (assoc :stencil (id-of (:stencil n)))
(node/source n)
(assoc-in [:source :symbol]
(get source-ids (node/source n)
(node/source n))))])))
nodes)
new-root (id-of root)
;; Paste reparents roots into one explicit destination.
;; Duplicate leaves them beside their originals.
copied (assoc-in copied [new-root :parent]
(when-not paste? parent))]
{:source-sid sid :old-root root :path path :root new-root
:nodes copied}))
(map-indexed vector items))]
{:clip clip :items made}))
(defn- shifted [n delta]
(if (node/placed-span n)
(update-in n [:time :at] (fnil + 0) delta)
n))
(defn- top-zs [nodes n]
(let [base (or (last (sort (map #(or (:z %) "") (vals nodes)))) "")]
(map #(str base (apply str (repeat % "m"))) (range 1 (inc n)))))
(defn- add-composition
[clip sid items at]
(let [starts (keep #(some-> (get-in % [:nodes (:root %)]) node/placed-span first) items)
anchor (when (seq starts) (apply min starts))
delta (if anchor (- at anchor) 0)
existing (get-in clip [:symbols sid :nodes])
zs (top-zs existing (count items))
nodes (reduce (fn [nodes [{:keys [root] copied :nodes} z]]
(into nodes (assoc-in copied [root]
(-> (get copied root)
(shifted delta)
(assoc :z z)))))
existing (map vector items zs))]
(assoc-in clip [:symbols sid :nodes] nodes)))
(defn- add-lane
[clip sid items at fresh-id]
(let [roots (map #(get-in % [:nodes (:root %)]) items)
starts (map #(some-> % node/placed-span first) roots)
anchor (when (every? some? starts) (apply min starts))
intervals (when anchor
(sort-by first
(map (fn [n]
(let [[lo hi] (node/placed-span n)]
[(+ at (- lo anchor)) (+ at (- hi anchor))]))
roots)))
overlaps? (some (fn [[[a b] [c d]]] (and (< a d) (< c b)))
(partition 2 1 intervals))]
(if (some nil? starts)
{:refused "a lane accepts copied things only when they have a finite span"}
(if overlaps?
{:refused "overlapping copied things cannot be pasted into one lane"}
(reduce
(fn [result item]
(if (:refused result)
(reduced result)
(let [c (:clip result)
root (:root item)
n (get-in item [:nodes root])
desired (+ at (- (first (node/placed-span n)) anchor))
r (span/place-node c sid n desired
{:extent :grow-symbol
:remainder-id (fresh (into #{} (keys (get-in c [:symbols sid :nodes])))
fresh-id)})]
(if-let [made (:clip r)]
{:clip (update-in made [:symbols sid :nodes]
into (dissoc (:nodes item) root))}
r))))
{:clip clip} items)))))
(defn paste
"Paste `clipboard` into `sid`, anchoring its first finite start at `at`.
`fresh-id` is supplied by the event so this domain command remains testable."
[clip clipboard sid at {:keys [fresh-id] :or {fresh-id random-uuid}}]
(cond
(nil? (clip/symbol clip sid)) {:refused "the paste target no longer exists"}
(not (and (integer? at) (not (neg? at))))
{:refused "the playhead is not on one frame of the paste target"}
(empty? (:items clipboard)) {:refused "there is nothing to paste"}
:else
(let [{base :clip items :items} (materialize clip (:items clipboard) fresh-id false true)
r (if (symbol/lane? (clip/symbol base sid))
(add-lane base sid items at fresh-id)
{:clip (add-composition base sid items at)})
made (:clip r)
why (when made (first (clip/problems made)))]
(cond
(:refused r) r
why {:refused why}
:else {:clip made :roots (mapv :root items)}))))
(defn- add-duplicate-composition [clip sid items]
(let [existing (get-in clip [:symbols sid :nodes])
zs (top-zs existing (count items))]
(assoc-in clip [:symbols sid :nodes]
(reduce (fn [nodes [{:keys [root] copied :nodes} z]]
(into nodes (assoc-in copied [root :z] z)))
existing (map vector items zs)))))
(defn- add-duplicate-lane
[clip sid items fresh-id]
(let [old-roots (map #(get-in clip [:symbols sid :nodes (:old-root %)]) items)
spans (map node/placed-span old-roots)
start (apply min (map first spans))
end (apply max (map second spans))
duration (- end start)
selected (set (map :old-root items))
shifted-clip
(update-in clip [:symbols sid :nodes]
(fn [nodes]
(reduce (fn [ns n]
(let [lo (some-> (node/placed-span n) first)]
(if (and (nil? (:parent n))
(not (contains? selected (:id n)))
lo (>= lo end))
(update-in ns [(:id n) :time :at] (fnil + 0) duration)
ns)))
nodes (vals nodes))))]
(reduce
(fn [result item]
(if (:refused result)
(reduced result)
(let [c (:clip result)
root (:root item)
n (get-in item [:nodes root])
old (get-in clip [:symbols sid :nodes (:old-root item)])
desired (+ (first (node/placed-span old)) duration)
r (span/place-node c sid n desired
{:extent :grow-symbol
:remainder-id (fresh (into #{} (keys (get-in c [:symbols sid :nodes])))
fresh-id)})]
(if-let [made (:clip r)]
{:clip (update-in made [:symbols sid :nodes]
into (dissoc (:nodes item) root))}
r))))
{:clip shifted-clip}
(sort-by #(first (node/placed-span
(get-in clip [:symbols sid :nodes (:old-root %)]))) items))))
(defn duplicate
"Duplicate a snapshot beside its sources. Direct finite children of lane
symbols repeat forward and ripple later cels; everything else copies in place.
With `:unique?`, referenced symbol graphs are deep-copied once for the batch."
[clip clipboard {:keys [fresh-id unique?] :or {fresh-id random-uuid}}]
(if (empty? (:items clipboard))
{:refused "select something to duplicate"}
(let [{base :clip items :items}
(materialize clip (:items clipboard) fresh-id unique? false)
groups (vals (group-by :source-sid items))
result
(reduce
(fn [result group]
(if (:refused result)
(reduced result)
(let [c (:clip result)
sid (:source-sid (first group))
lane? (symbol/lane? (clip/symbol c sid))
[lane-items other]
((juxt filter remove)
#(let [old (get-in clip [:symbols sid :nodes (:old-root %)])]
(and lane? (nil? (:parent old)) (node/placed-span old)))
group)
c (if (seq other) (add-duplicate-composition c sid other) c)
r (if (seq lane-items)
(add-duplicate-lane c sid lane-items fresh-id)
{:clip c})]
r)))
{:clip base} groups)
made (:clip result)
why (when made (first (clip/problems made)))]
(cond
(:refused result) result
why {:refused why}
:else {:clip made
:roots (mapv (fn [{:keys [source-sid root path]}]
{:sid source-sid :id root
:path (conj (vec (butlast path)) root)})
items)}))))

View file

@ -31,14 +31,19 @@
:else :else
(let [clip (leaf/clip "u" (:leaves r)) (let [clip (leaf/clip "u" (:leaves r))
[kind host node] (get-in db [:ui :selection]) valid? (fn [[kind host node]]
(or (not= :node kind)
(nil? node)
(get-in clip [:symbols host :nodes node])))
selections (vec (filter valid? (get-in db [:ui :selections])))
primary (get-in db [:ui :selection])
primary (if (valid? primary) primary (peek selections))
label (:label (peek (get (:history r) (if (= done "undone") :undone :done))))] label (:label (peek (get (:history r) (if (= done "undone") :undone :done))))]
{:ok? true {:ok? true
:db (-> (edit/replace-entry db #(assoc % :clip clip :history (:history r))) :db (-> (edit/replace-entry db #(assoc % :clip clip :history (:history r)))
(edit/transport clip) (edit/transport clip)
;; A selection of what the step removed selects nothing. (assoc-in [:ui :selections] selections)
(cond-> (and (= :node kind) (nil? (get-in clip [:symbols host :nodes node]))) (assoc-in [:ui :selection] primary)
(update :ui dissoc :selection))
(assoc-in [:project :status] (str done " " label " · unsaved")))})))) (assoc-in [:project :status] (str done " " label " · unsaved")))}))))
(defn- steps (defn- steps
@ -70,19 +75,24 @@
(or (#{"INPUT" "TEXTAREA" "SELECT"} (.-tagName target)) (.-isContentEditable target))) (or (#{"INPUT" "TEXTAREA" "SELECT"} (.-tagName target)) (.-isContentEditable target)))
(defn install-keys! (defn install-keys!
"⌘Z / Ctrl+Z undoes, with Shift redoes, and Ctrl+Y redoes; Delete or "The document edit keys. Not while typing in a field, where the browser's own
Backspace deletes the selected node, which undo brings back. Not while typing clipboard and undo stack are the ones wanted."
in a field, where the browser's own keys are the ones wanted."
[] []
(.addEventListener (.addEventListener
js/window "keydown" js/window "keydown"
(fn [^js e] (fn [^js e]
(when-not (typing? (.-target e)) (when-not (typing? (.-target e))
(let [k (.toLowerCase (.-key e))] (let [k (.toLowerCase (.-key e))]
(when-let [ev (if (or (.-metaKey e) (.-ctrlKey e)) (when-let [ev (if (and (or (.-metaKey e) (.-ctrlKey e))
(not (.-altKey e)))
(cond (and (= k "z") (.-shiftKey e)) ::redo (cond (and (= k "z") (.-shiftKey e)) ::redo
(= k "z") ::undo (= k "z") ::undo
(= k "y") ::redo) (= k "y") ::redo
(= k "c") ::ui/copy
(= k "x") ::ui/cut
(= k "v") ::ui/paste
(and (= k "d") (.-shiftKey e)) ::ui/duplicate-unique
(= k "d") ::ui/duplicate)
(when (#{"delete" "backspace"} k) ::ui/delete-selected))] (when (#{"delete" "backspace"} k) ::ui/delete-selected))]
(.preventDefault e) (.preventDefault e)
(rf/dispatch [ev]))))))) (rf/dispatch [ev])))))))

View file

@ -20,6 +20,7 @@
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 [clojure.string :as str] (:require [clojure.string :as str]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.clipboard :as clipboard]
[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]
@ -127,6 +128,22 @@
(-> (selected db primary) (assoc-in [:ui :selections] xs)) (-> (selected db primary) (assoc-in [:ui :selections] xs))
(selected db nil))))) (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 (rf/reg-event-db
::aim ::aim
;; The gestures that name a PLACE in the document rather than a thing on ;; The gestures that name a PLACE in the document rather than a thing on
@ -473,6 +490,133 @@
down (where-new-goes clip db)] down (where-new-goes clip db)]
(assoc (nest/inside clip st open down frame) :path down))) (assoc (nest/inside clip st open down frame) :path down)))
;; ---------------------------------------------------------------------------
;; clipboard and local duplication
(defn- current-selections [db]
(let [primary (get-in db [:ui :selection])
many (vec (get-in db [:ui :selections]))]
(cond (nil? primary) []
(some #{primary} many) many
:else [primary])))
(defn- command-refused [db why]
(assoc-in db [:project :status] why))
(defn- select-results [db addresses]
(let [addresses (vec addresses)]
(if-let [primary (peek addresses)]
(-> db
(assoc-in [:ui :selection] primary)
(assoc-in [:ui :selections] addresses)
(update :ui dissoc :points :retry))
(-> db
(assoc-in [:ui :selection] nil)
(assoc-in [:ui :selections] [])))))
(rf/reg-event-db
::copy
(fn [db _]
(let [clip (:clip (store/entry (:clip/current db)))
r (clipboard/snapshot clip (current-selections db))]
(if-let [why (:refused r)]
(command-refused db why)
(-> db
(assoc-in [:ui :clipboard] (:clipboard r))
(assoc-in [:project :status]
(str "copied " (count (get-in r [:clipboard :items])))))))))
(rf/reg-event-db
::cut
(fn [db _]
(let [clip (:clip (store/entry (:clip/current db)))
snapped (clipboard/snapshot clip (current-selections db))]
(if-let [why (:refused snapped)]
(command-refused db why)
(let [r (clipboard/cut clip (:clipboard snapped))]
(if-let [why (:refused r)]
(command-refused db why)
(-> db
(assoc-in [:ui :clipboard] (:clipboard snapped))
(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."
[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)
{:refused "the paste target no longer exists"}
(= :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)}
{:refused "the playhead has no single frame inside the paste target"}))
:else
(if (number? owner-frame)
{:sid sid :path (vec (butlast path)) :frame (js/Math.floor owner-frame)}
{:refused "the playhead has no single frame in the paste target"}))))
(rf/reg-event-db
::paste
(fn [db _]
(let [{clip :clip st :store} (store/entry (:clip/current db))
payload (get-in db [:ui :clipboard])
destination (paste-destination db clip st)]
(if-let [why (:refused destination)]
(command-refused db why)
(let [{:keys [sid path frame]} destination
r (clipboard/paste clip payload sid frame {:fresh-id random-uuid})]
(if-let [why (:refused r)]
(command-refused db why)
(-> db
(edit/transaction (constantly (:clip r)))
(select-results
(mapv (fn [id] [:node sid id (conj path id)]) (:roots r))))))))))
(defn- duplicate-selected [db unique?]
(let [clip (:clip (store/entry (:clip/current db)))
snapped (clipboard/snapshot clip (current-selections db))]
(if-let [why (:refused snapped)]
(command-refused db why)
(let [r (clipboard/duplicate clip (:clipboard snapped)
{:fresh-id random-uuid :unique? unique?})]
(if-let [why (:refused r)]
(command-refused db why)
(-> db
(edit/transaction (constantly (:clip r)))
(select-results
(mapv (fn [{:keys [sid id path]}] [:node sid id path]) (:roots r)))))))))
(rf/reg-event-db ::duplicate (fn [db _] (duplicate-selected db false)))
(rf/reg-event-db ::duplicate-unique (fn [db _] (duplicate-selected db true)))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; drawing a polygon ;; drawing a polygon
;; ;;
@ -974,7 +1118,7 @@
nodes (distinct (keep (fn [[kind sid id]] (when (= :node kind) [sid id])) selections))] nodes (distinct (keep (fn [[kind sid id]] (when (= :node kind) [sid id])) selections))]
(if (seq nodes) (if (seq nodes)
(-> db (-> db
(edit/edit #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes)) (edit/transaction #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes))
(assoc-in [:ui :selection] nil) (assoc-in [:ui :selection] nil)
(assoc-in [:ui :selections] [])) (assoc-in [:ui :selections] []))
db)))) db))))

View file

@ -24,6 +24,7 @@
(some #{primary} many) many (some #{primary} many) many
:else [primary])))) :else [primary]))))
(rf/reg-sub ::target (fn [db _] (get-in db [:ui :target]))) (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 ::retry (fn [db _] (get-in db [:ui :retry])))
(rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone]))) (rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone])))
(rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool]))) (rf/reg-sub ::tool (fn [db _] (get-in db [:ui :tool])))

View file

@ -584,8 +584,9 @@
(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 lane? 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 renaming draft] selection selections target over solo tracing renaming draft]
(let [node? (= :node kind) (let [node? (= :node kind)
selected? (contains? selections select)
;; 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
@ -599,7 +600,8 @@
(let [[_ sid id] select] (let [[_ sid id] select]
(rf/dispatch [::ui/rename-node sid id @draft])))) (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 selected?) " on")
(when (and select (= select selection)) " primary")
(when aimed? " aimed") (when aimed? " aimed")
(when lane? " lane") (when lane? " lane")
(when (= :ghost kind) " ghost") (when (= :ghost kind) " ghost")
@ -616,7 +618,12 @@
;; clicking its bar or one of its cels, below, says "show me ;; clicking its bar or one of its cels, below, says "show me
;; this", which is a statement about a thing on screen. Only ;; this", which is a statement about a thing on screen. Only
;; 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 (fn [^js e]
(when select
(rf/dispatch [(if (.-shiftKey e)
::ui/toggle-and-aim
::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 (fn [^js e] :on-double-click (fn [^js e]
(when of (when of
@ -718,8 +725,9 @@
moved since. What it looks like mid-drag is `[:ui :sliding]`, which the clip 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." 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]} [{:keys [path span keys dense? kind node-kind select slides cels lane? of unmapped? owner]}
frames sliding hint {:keys [clip store open frame selection]}] frames sliding hint {:keys [clip store open selection selections]}]
(let [active-row (:row @sliding) (let [selected-set (set selections)
active-row (:row @sliding)
slide (fn [^js e] slide (fn [^js e]
(let [{from :row pressed :from} @sliding] (let [{from :row pressed :from} @sliding]
(when (= path from) (when (= path from)
@ -742,11 +750,19 @@
under (when (and drag shift?) (clip-under e)) under (when (and drag shift?) (clip-under e))
;; Asked of the command itself, so the hint cannot ;; Asked of the command itself, so the hint cannot
;; promise what the drop would refuse. ;; promise what the drop would refuse.
;; THE PLAYHEAD, READ HERE AND NOT TAKEN AS A
;; PROP. As a prop it was a new value on every tick,
;; so every cell in the pane re-rendered throughout
;; playback for a number that only a shift-drag ever
;; reads. This runs from a pointer handler rather
;; than a render, so the deref takes no dependency
;; on it, and on this rare a path an uncached sub
;; costs nothing.
why (when (and under (not= (:select under) (:selection drag))) why (when (and under (not= (:select under) (:selection drag)))
(nest/move-refusal clip store open (nest/move-refusal clip store open
(nth (:selection drag) 3) (nth (:selection drag) 3)
(nth (:select under) 3) (nth (:select under) 3)
frame)) @(rf/subscribe [::render/open-frame])))
nest (when (and under (nil? why) nest (when (and under (nil? why)
(not= (:select under) (:selection drag))) (not= (:select under) (:selection drag)))
under) under)
@ -800,7 +816,7 @@
done (fn [commit?] done (fn [commit?]
(when (= path (:row @sliding)) (when (= path (:row @sliding))
(let [{:keys [path df kind ripple? other target-lane target-frame (let [{:keys [path df kind ripple? other target-lane target-frame
drag nest on-click]} @sliding] drag nest on-click more?]} @sliding]
(reset! sliding nil) (reset! sliding nil)
(when hint (reset! hint nil)) (when hint (reset! hint nil))
(cond (cond
@ -819,7 +835,9 @@
;; that only moved in time leaves what it moved ;; that only moved in time leaves what it moved
;; selected. The two structural cases above select what ;; selected. The two structural cases above select what
;; they landed, so neither needs this. ;; they landed, so neither needs this.
(do (when on-click (rf/dispatch [::ui/select on-click])) (do (when on-click
(rf/dispatch [(if more? ::ui/toggle-selection ::ui/select)
on-click]))
(rf/dispatch [::ui/slide path df kind ripple? other owner])) (rf/dispatch [::ui/slide path df kind ripple? other owner]))
:else (rf/dispatch [::ui/sliding nil]))))) :else (rf/dispatch [::ui/sliding nil])))))
begin! (fn [^js e actual-path gesture-kind actual-select other drag] begin! (fn [^js e actual-path gesture-kind actual-select other drag]
@ -835,6 +853,7 @@
(reset! sliding {:row path :path actual-path :kind gesture-kind (reset! sliding {:row path :path actual-path :kind gesture-kind
:other other :other other
:on-click actual-select :on-click actual-select
:more? (.-shiftKey e)
:drag (when drag :drag (when drag
(assoc drag (assoc drag
:grab (- (frame-under e frames track) :grab (- (frame-under e frames track)
@ -912,7 +931,8 @@
(when (= :audio node-kind) " sound") (when (= :audio node-kind) " sound")
(when unmapped? " unmapped") (when unmapped? " unmapped")
(when (and select (not unmapped?)) " movable") (when (and select (not unmapped?)) " movable")
(when (and select (= select selection)) " on") (when (and select (contains? selected-set select)) " on")
(when (and select (= select selection)) " primary")
(when (= path active-row) " sliding")) (when (= path active-row) " sliding"))
:title (when unmapped? :title (when unmapped?
"inside a held clip · its own frames have no place on this ruler") "inside a held clip · its own frames have no place on this ruler")
@ -920,7 +940,10 @@
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")} :width (str (* 100 (/ (- out in) (max 1 frames))) "%")}
:on-click (when (and select unmapped?) :on-click (when (and select unmapped?)
(fn [^js e] (.stopPropagation e) (fn [^js e] (.stopPropagation e)
(rf/dispatch [::ui/select select]))) (rf/dispatch [(if (.-shiftKey e)
::ui/toggle-selection
::ui/select)
select])))
:on-pointer-down :on-pointer-down
(when (and select (not unmapped?)) (when (and select (not unmapped?))
#(begin! % (or slides path) :slide select nil nil))} #(begin! % (or slides path) :slide select nil nil))}
@ -951,7 +974,8 @@
;; unexplained. It wears the pick colour rather than the accent every ;; unexplained. It wears the pick colour rather than the accent every
;; span and drop already uses — see `--pick` in app.css. ;; span and drop already uses — see `--pick` in app.css.
:class (str (when ghost? "ghost") :class (str (when ghost? "ghost")
(when (and select (= select selection)) " on") (when (and select (contains? selected-set select)) " on")
(when (and select (= select selection)) " primary")
(when (and select (= select (get-in @sliding [:nest :select]))) (when (and select (= select (get-in @sliding [:nest :select])))
" nest-target")) " nest-target"))
:style {:position "absolute" :left (edge% in frames) :style {:position "absolute" :left (edge% in frames)
@ -1026,6 +1050,19 @@
:style {:left (str (+ x 16) "px") :top (str (+ y 18) "px")}} :style {:left (str (+ x 16) "px") :top (str (+ y 18) "px")}}
text])) text]))
(defn- playhead
"The knob on the ruler and the line down the tracks, as their own component.
THE PLAYHEAD IS THE ONLY THING IN THIS PANE THAT MOVES DURING PLAYBACK, so it
derefs the frame ITSELF and is the only thing the frame moving re-renders.
Read in `timeline-view`'s body instead — which is where it was — `::pb/tick`
invalidated the whole pane every painted frame: `rows`, `sound-rows` and the
symbol ordering recomputed from scratch and every track cell re-rendered, all
to move two elements' `left`. That cost more than painting the frame did and
starved the rAF loop painting it, which ran at 16fps against a 60fps ceiling."
[tag frames]
[tag {:style {:left (at% @(rf/subscribe [::render/open-frame]) frames)}}])
(defn- timeline-view [] (defn- timeline-view []
(r/with-let [scrubbing (r/atom false) (r/with-let [scrubbing (r/atom false)
;; 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
@ -1042,9 +1079,10 @@
;; converting and rounding — see `docs/one-grid-plan.md`. The transport ;; converting and rounding — see `docs/one-grid-plan.md`. The transport
;; keeps the output numbers; this pane does not use them. ;; keeps the output numbers; this pane does not use them.
frames (max 1 (or @(rf/subscribe [::render/open-frames]) 1)) frames (max 1 (or @(rf/subscribe [::render/open-frames]) 1))
frame @(rf/subscribe [::render/open-frame])
store @(rf/subscribe [::render/store]) store @(rf/subscribe [::render/store])
selection @(rf/subscribe [::sub/selection]) selection @(rf/subscribe [::sub/selection])
selections @(rf/subscribe [::sub/selections])
selection-set (set selections)
target @(rf/subscribe [::sub/target]) target @(rf/subscribe [::sub/target])
expanded @(rf/subscribe [::sub/expanded]) expanded @(rf/subscribe [::sub/expanded])
drop @(rf/subscribe [::sub/drop]) drop @(rf/subscribe [::sub/drop])
@ -1140,7 +1178,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 renaming draft]) [label-cell row selection selection-set target over solo tracing renaming draft])
{:key (str (:path row))})))] {:key (str (:path row))})))]
[:div.tl-tracks [:div.tl-tracks
{:on-click (fn [^js e] {:on-click (fn [^js e]
@ -1196,17 +1234,17 @@
(doall (doall
(for [f (range 0 frames step)] (for [f (range 0 frames step)]
^{:key f} [:div.tick {:style {:left (edge% f frames)}} f])) ^{:key f} [:div.tick {:style {:left (edge% f frames)}} f]))
[:div.tl-knob {:style {:left (at% frame frames)}}]] [playhead :div.tl-knob frames]]
(if (seq visible) (if (seq visible)
(doall (for [row visible] (doall (for [row visible]
(with-meta (if (= :section (:kind row)) (with-meta (if (= :section (:kind row))
[:div.tl-track.tl-section] [:div.tl-track.tl-section]
[track-cell row frames sliding hint [track-cell row frames sliding hint
{:clip clip :store store :open open :frame frame {:clip clip :store store :open open
:selection selection}]) :selection selection :selections selections}])
{:key (str (:path row))}))) {:key (str (:path row))})))
[:div.tl-empty "nothing in this symbol"]) [:div.tl-empty "nothing in this symbol"])
[:div.tl-playhead {:style {:left (at% frame frames)}}]]] [playhead :div.tl-playhead frames]]]
[cursor-hint hint]]))) [cursor-hint hint]])))
(defn view [] (defn view []

View file

@ -8,8 +8,11 @@
(:require [arthur.events.collab :as collab] (:require [arthur.events.collab :as collab]
[arthur.events.export :as export] [arthur.events.export :as export]
[arthur.events.project :as project] [arthur.events.project :as project]
[arthur.events.ui :as ui]
[arthur.subs.playback :as playback] [arthur.subs.playback :as playback]
[arthur.subs.ui :as sub]
[arthur.ui.layout :as layout] [arthur.ui.layout :as layout]
[arthur.ui.menu :as menu]
[arthur.ui.openmenu :as openmenu] [arthur.ui.openmenu :as openmenu]
[arthur.ui.share :as share] [arthur.ui.share :as share]
[arthur.ui.snapshots :as snapshots] [arthur.ui.snapshots :as snapshots]
@ -49,9 +52,12 @@
(r/with-let [renaming? (r/atom false) (r/with-let [renaming? (r/atom false)
draft (r/atom "") draft (r/atom "")
export-open? (r/atom false)] export-open? (r/atom false)]
(let [{project-name :name :keys [busy? seq status]} @(rf/subscribe [::playback/project]) (let [{project-name :name project-seq :seq :keys [busy? status]} @(rf/subscribe [::playback/project])
{footage-status :status} @(rf/subscribe [::playback/footage]) {footage-status :status} @(rf/subscribe [::playback/footage])
{export-status :status} @(rf/subscribe [::export/state]) {export-status :status} @(rf/subscribe [::export/state])
selections @(rf/subscribe [::sub/selections])
clipboard @(rf/subscribe [::sub/clipboard])
selected? (boolean (seq selections))
title (or project-name "untitled") title (or project-name "untitled")
commit! (fn [] commit! (fn []
(rf/dispatch [::project/rename @draft]) (rf/dispatch [::project/rename @draft])
@ -66,6 +72,20 @@
[:button {:disabled busy? :on-click #(rf/dispatch [::collab/create])} "new"] [:button {:disabled busy? :on-click #(rf/dispatch [::collab/create])} "new"]
[openmenu/view] [openmenu/view]
[undo/view] [undo/view]
[menu/view
{:label "edit" :title "selection and clipboard"
:items [{:label "copy" :sub "Copy selection · ⌘/Ctrl C"
: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"
:disabled? (nil? clipboard) :on-click #(rf/dispatch [::ui/paste])}
{:label "duplicate" :sub "Duplicate here; 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"
:disabled? (not selected?)
:on-click #(rf/dispatch [::ui/duplicate-unique])}]}]
[snapshots/view] [snapshots/view]
(if @renaming? (if @renaming?
[:input.project-name {:auto-focus true :value @draft [:input.project-name {:auto-focus true :value @draft
@ -79,7 +99,7 @@
[:button.project-title {:disabled busy? :title "click to rename project" [:button.project-title {:disabled busy? :title "click to rename project"
:on-click (fn [] (reset! draft title) :on-click (fn [] (reset! draft title)
(reset! renaming? true))} (reset! renaming? true))}
title (when seq (str " r" seq))]) title (when project-seq (str " r" project-seq))])
[:span.status (or export-status status footage-status)] [:span.status (or export-status status footage-status)]
[exporter export-open?] [exporter export-open?]
[share/view]]))) [share/view]])))

View file

@ -0,0 +1,96 @@
(ns arthur.domain.clipboard-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.clip :as clip]
[arthur.domain.clipboard :as clipboard]
[arthur.domain.node :as node]
[arthur.domain.sequence-test :as fixture]))
(defn- ids []
(let [n (atom 0)]
#(keyword (str "copy-" (swap! n inc)))))
(defn- address [sid id path] [:node sid id path])
(deftest canonical-selection-is-an-occurrence-forest
(let [doc (-> (fixture/document)
(assoc-in [:symbols :drawing-a :nodes :g]
{:id :g :kind :group :z "g"})
(assoc-in [:symbols :drawing-a :nodes :child]
{:id :child :kind :rect :parent :g :z "h"}))
selections [(address :drawing-a :child [:a :g :child])
(address :drawing-a :g [:a :g])]
payload (get-in (clipboard/snapshot doc selections) [:clipboard :items])]
(is (= 1 (count payload)))
(is (= :g (:root (first payload))))
(is (= #{:g :child} (set (keys (:nodes (first payload))))))))
(deftest copy-paste-remaps-the-subtree-and-keeps-shared-content
(let [doc (fixture/document)
payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))
r (clipboard/paste (update-in doc [:symbols :main] dissoc :display)
payload :main 20 {:fresh-id (ids)})
made (:clip r)
id (first (:roots r))
n (get-in made [:symbols :main :nodes id])]
(is (nil? (:refused r)))
(is (= :drawing-a (node/source n)) "normal paste keeps symbol identity")
(is (= [20 24] (node/placed-span n)))
(is (= 12 (get-in made [:symbols :main :frames]))
"an ordinary symbol may contain cropped content beyond its window")
(is (empty? (clip/problems made)))))
(deftest lane-paste-claims-time-as-one-command
(let [doc (fixture/document)
payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))
r (clipboard/paste doc payload :main 4 {:fresh-id (ids)})
made (:clip r)
id (first (:roots r))]
(is (= :drawing-a (node/source (get-in made [:symbols :main :nodes id]))))
(is (nil? (get-in made [:symbols :main :nodes :b]))
"the pasted interval replaces the cel it covers")
(is (= [4 8] (node/placed-span (get-in made [:symbols :main :nodes id]))))
(is (empty? (clip/problems made)))))
(deftest lane-duplicate-is-the-forward-repeat-and-ripples-later-cels
(let [doc (fixture/document)
payload (:clipboard
(clipboard/snapshot doc [(address :main :a [:a])
(address :main :b [:b])]))
r (clipboard/duplicate doc payload {:fresh-id (ids)})
made (:clip r)
[a2 b2] (map :id (:roots r))]
(is (= [8 12] (node/placed-span (get-in made [:symbols :main :nodes a2]))))
(is (= [12 16] (node/placed-span (get-in made [:symbols :main :nodes b2]))))
(is (= [16 20] (node/placed-span (get-in made [:symbols :main :nodes :insert]))))
(is (= 20 (get-in made [:symbols :main :frames])))
(is (empty? (clip/problems made)))))
(deftest duplicate-unique-copies-one-complete-shared-symbol-graph
(let [doc (-> (fixture/document)
(assoc-in [:symbols :drawing-a :nodes :part]
{:id :part :kind :instance :z "b" :span [0 1]
:time {:at 0 :rate 1} :source {:symbol :wave}
:playback {:in 0 :speed 0 :end :stop}})
(update-in [:symbols :main] dissoc :display))
payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))
shared (:clip (clipboard/duplicate doc payload {:fresh-id (ids)}))
unique-r (clipboard/duplicate doc payload {:fresh-id (ids) :unique? true})
unique (:clip unique-r)
shared-id (:id (first (:roots (clipboard/duplicate doc payload {:fresh-id (ids)}))))
unique-id (:id (first (:roots unique-r)))
unique-source (node/source (get-in unique [:symbols :main :nodes unique-id]))]
(is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes shared-id]))))
(is (not= :drawing-a unique-source))
(is (not= :wave (node/source (get-in unique [:symbols unique-source :nodes :part]))))
(is (empty? (clip/problems unique)))))
(deftest cut-keeps-the-snapshot-and-deletes-a-whole-subtree
(let [doc (-> (fixture/document)
(assoc-in [:symbols :main :nodes :child]
{:id :child :kind :rect :parent :plate :z "b"}))
payload (:clipboard (clipboard/snapshot doc [(address :main :plate [:plate])]))
made (:clip (clipboard/cut doc payload))]
(is (= #{:plate :child} (set (keys (:nodes (first (:items payload)))))))
(is (nil? (get-in made [:symbols :main :nodes :plate])))
(is (nil? (get-in made [:symbols :main :nodes :child])))
(is (empty? (clip/problems made)))))

View file

@ -104,6 +104,22 @@
(is (= 12 (ui/selection-frame doc nil :main (is (= 12 (ui/selection-frame doc nil :main
[:node :main :a [:a]] 12))))) [:node :main :a [:a]] 12)))))
(deftest paste-targeting-continues-an-instance-clock-past-its-window
(let [doc {:fps 24 :width 20 :height 20
:symbols
{:main {:id :main :frames 40
:nodes {:drawing {:id :drawing :kind :instance :z "a"
:span [0 10] :time {:at 0 :rate 1}
:source {:symbol :inside}
:playback {:in 0 :speed 1 :end :stop}}}}
:inside {:id :inside :frames 10 :nodes {}}}}
db {:ui {:open :main
:target {:sid :main :id :drawing :path [: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")))
(deftest polygon-landing-obeys-the-destination-symbol-mode (deftest polygon-landing-obeys-the-destination-symbol-mode
(let [lane (fixture/document) (let [lane (fixture/document)
ordinary (update-in lane [:symbols :main] dissoc :display) ordinary (update-in lane [:symbols :main] dissoc :display)

View file

@ -96,6 +96,14 @@ try {
}; };
const shot = async () => JSON.parse(JSON.stringify(await evaluate('laneSnapshot()'), const shot = async () => JSON.parse(JSON.stringify(await evaluate('laneSnapshot()'),
(_key, value) => value?.uuid ?? value)); (_key, value) => value?.uuid ?? value));
const shortcut = async (key, code, modifiers = 2) => {
const windowsVirtualKeyCode = key.toUpperCase().charCodeAt(0);
await send('Input.dispatchKeyEvent', {type: 'rawKeyDown', key, code, modifiers,
windowsVirtualKeyCode});
await send('Input.dispatchKeyEvent', {type: 'keyUp', key, code, modifiers: 0,
windowsVirtualKeyCode});
await sleep(180);
};
const mainInstances = s => Object.values(s.clip.symbols.main.nodes) const mainInstances = s => Object.values(s.clip.symbols.main.nodes)
.filter(n => n.kind === 'instance'); .filter(n => n.kind === 'instance');
const laneSymbols = s => Object.values(s.clip.symbols).filter(sym => sym.display === 'lane'); const laneSymbols = s => Object.values(s.clip.symbols).filter(sym => sym.display === 'lane');
@ -109,7 +117,7 @@ try {
assert.equal(placed.length, 1, 'new symbol places one instance'); assert.equal(placed.length, 1, 'new symbol places one instance');
assert.equal(s.clip.symbols[placed[0].source.symbol].display, undefined, assert.equal(s.clip.symbols[placed[0].source.symbol].display, undefined,
'new symbol remains ordinary'); 'new symbol remains ordinary');
assert.equal(await evaluate('document.querySelectorAll(".tl-track").length'), 1, assert.equal(await evaluate('document.querySelectorAll(".tl-track:not(.palette)").length'), 1,
'an ordinary symbol is an ordinary timeline row'); 'an ordinary symbol is an ordinary timeline row');
await clickNew('lane'); await clickNew('lane');
@ -151,16 +159,17 @@ try {
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx, y: drop.sy}); await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx, y: drop.sy});
await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: drop.sx, y: drop.sy, await send('Input.dispatchMouseEvent', {type: 'mousePressed', x: drop.sx, y: drop.sy,
button: 'left', buttons: 1, clickCount: 1}); button: 'left', buttons: 1, clickCount: 1});
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx + 12, y: drop.sy, await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx + 6, y: drop.sy,
button: 'left', buttons: 1}); button: 'left', buttons: 1});
await sleep(100); await sleep(60);
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.sx + 18, y: drop.sy,
button: 'left', buttons: 1});
await sleep(140);
await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.tx, y: drop.ty, await send('Input.dispatchMouseEvent', {type: 'mouseMoved', x: drop.tx, y: drop.ty,
button: 'left', buttons: 1}); button: 'left', buttons: 1});
await sleep(120); await sleep(300);
assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0, assert.equal(await evaluate('document.querySelectorAll(".tl-label.ghost").length'), 0,
'pool drop does not preview an invented lane'); 'pool drop does not preview an invented lane');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel.ghost").length'), 1,
'pool drop previews inside the existing lane');
await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: drop.tx, y: drop.ty, await send('Input.dispatchMouseEvent', {type: 'mouseReleased', x: drop.tx, y: drop.ty,
button: 'left', buttons: 0, clickCount: 1}); button: 'left', buttons: 0, clickCount: 1});
await sleep(300); await sleep(300);
@ -196,8 +205,51 @@ try {
s = await shot(); s = await shot();
assert.deepEqual(laneSymbols(s).map(x => Object.keys(x.nodes).length).sort(), [0, 1], assert.deepEqual(laneSymbols(s).map(x => Object.keys(x.nodes).length).sort(), [0, 1],
'a clip body moves from one explicit lane to the other'); 'a clip body moves from one explicit lane to the other');
// Start a clean local document for clipboard and timeline multi-selection.
await evaluate(`re_frame.core.dispatch_sync(cljs.core.vector(
cljs.core.keyword('arthur.events.project/new'))) `);
await sleep(250);
await clickNew('inside');
const clipboardBaseline = (await shot()).clip;
await shortcut('d', 'KeyD');
assert.equal(mainInstances(await shot()).length, 2, 'duplicate copies the selected instance');
await shortcut('z', 'KeyZ');
assert.equal(mainInstances(await shot()).length, 1, 'one undo removes the whole duplicate');
await shortcut('z', 'KeyZ', 10);
assert.equal(mainInstances(await shot()).length, 2, 'one redo restores the duplicate');
assert(await evaluate(`(() => {
const rows = [...document.querySelectorAll('.tl-label')].filter(x => x.draggable);
if (rows.length < 2) return false;
rows[0].click();
rows[1].dispatchEvent(new MouseEvent('click', {bubbles: true, shiftKey: true}));
return true;
})()`), 'two timeline rows are available for multi-selection');
await sleep(200);
assert.equal(await evaluate('document.querySelectorAll(".tl-label.on").length'), 2,
'timeline Shift-click mirrors the two-member selection');
assert(await evaluate(`(() => {
const row = [...document.querySelectorAll('.tl-label')].find(x => x.draggable);
if (!row) return false; row.click(); return true;
})()`), 'a timeline row can select the redone instance');
await sleep(120);
await shortcut('c', 'KeyC');
await shortcut('x', 'KeyX');
assert.equal(mainInstances(await shot()).length, 1, 'cut removes the selection');
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))`);
await sleep(80);
await shortcut('v', 'KeyV');
assert.equal(mainInstances(await shot()).length, 3, 'paste uses the copied snapshot');
await shortcut('z', 'KeyZ');
await shortcut('z', 'KeyZ');
assert.equal(mainInstances(await shot()).length, 1, 'clipboard edits undo independently');
assert.deepEqual((await shot()).clip, clipboardBaseline,
'clipboard exercises undo back to the byte-for-byte document');
assert.equal(errors.length, 0, JSON.stringify(errors)); assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: symbols are ordinary; explicit lanes rename, accept drops, and exchange clips'); console.log('PASS: lanes, mirrored selection, and atomic clipboard commands');
} finally { } finally {
if (ws?.readyState === WebSocket.OPEN) ws.close(); if (ws?.readyState === WebSocket.OPEN) ws.close();
chrome.kill('SIGTERM'); chrome.kill('SIGTERM');