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

Reuse, duplicate and make unique: deciding what is shared

Browse source 
The model's whole claim is that content and its occurrences are different
things, and until now nothing in the editor could tell them apart: you could
make a drawing and time it, but not expose one drawing twice, and so never find
out whether an edit arrives in two places. That is the first proof obligation in
the lane model and it was the one the commands could not reach.

Three commands, and the distinctions between them are the point:

  reuse       another occurrence of the same drawing. A decision to share,
              made on purpose, because sharing discovered later — when an edit
              turns up somewhere you did not expect — is the bad version.
  duplicate   a copy of the drawing, appended, for when what is on screen is
              the starting point for the next one.
  make unique this occurrence gets a private copy; the others keep sharing.
              The undo of reuse, and refused when nothing else uses the
              drawing: a copy nobody asked for is a second identical symbol in
              the library for no reason a person could see.

Duplicate copies the CONTENT and not the exposure. Its new occurrence is a plain
one-frame hold, not a copy of the source occurrence's transform or corrections,
because those belong to that use of the drawing — carrying them over would make
duplicating a drawing quietly duplicate the treatment of one exposure of it.

A copy is SHALLOW by default and keeps its references to other symbols, so a
head built out of reusable eyes still uses those eyes. `:deep? true` copies
everything it places with new ids throughout. The lane model asks for both and
says why: never promise decoupling while leaving the edited object shared, and
only the deep copy can keep that promise. `bring/symbols` already did the
reachability walk and the id remapping, so the deep copy is that function
pointed at its own clip.

`node/sources` was still being read as a SET at five call sites, each with a
comment about a lane that cuts between several drawings — the keyed source that
no longer exists. An occurrence names one symbol, so they now ask `node/source`,
and `placed-frame` answers with `:symbol` rather than `:of`, which was the last
echo of the retired field name.

To let the commands use `clip/free-id` and the copy machinery, the lane's own
validation moved from `domain/sequence` to `domain/symbol`, which is where it
belonged anyway: a sequence is the one composition rule a node map carries, and
it now sits beside the parent and stencil checks rather than in the namespace
that happens to build lanes. That also breaks the cycle — sequence can require
clip and bring, and nothing below it requires sequence. Preconditions still
check only the LANE's shape: refusing an exposure edit over an unrelated defect
elsewhere in the symbol would be this command answering for a part of the
document it never touches.

The cel strip gains reuse, duplicate and make unique, the last shown only where
the selected exposure actually shares its drawing. Drawing on twos is also now
under test: exposure length is the cadence, the lane's transform has its own
clock, and it still moves on every frame — stepping it would be the cel cadence
leaking into continuous motion.

397 tests, 5,561 assertions. `test/browser/sequence.mjs` drives the three new
commands through the real editor and checks that three exposures are still one
row.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Your Name 2026-09-30 15:30:59 -04:00
parent 3d3c1bbca0
commit 9446829774
7 changed files with 427 additions and 83 deletions
Download patch file Download diff file Expand all files Collapse all files

34
docs/lane-model.md
View file

@ -1,9 +1,10 @@
# The Lane Model # The Lane Model
Revised 2026-09-30. Target design. Occurrence ownership, source playback, the Revised 2026-09-30. Target design. Occurrence ownership, source playback, the
first exposure commands and a one-row cel strip are implemented; correction content and exposure commands and a one-row cel strip are implemented;
layers, the other commands and the remaining views are not. See the status note correction layers, the range and retiming commands, and the remaining views are
under [Proof obligations](#proof-obligations-and-implementation-order). not. See the status note under
[Proof obligations](#proof-obligations-and-implementation-order).
This revises the Claude artifact [The Lane Model](https://claude.ai/code/artifact/cd42981d-ed08-493f-94df-b7dd6657f0e6). This revises the Claude artifact [The Lane Model](https://claude.ai/code/artifact/cd42981d-ed08-493f-94df-b7dd6657f0e6).
Its prose and diagram source were recovered from session Its prose and diagram source were recovered from session
@ -439,18 +440,25 @@ drawing remain distinct events. Deduplicating identical ghosts is a display opti
The source-channel prototype has been removed: an occurrence names one symbol The source-channel prototype has been removed: an occurrence names one symbol
and carries its own playback clock, and `node/problems` rejects the old and carries its own playback clock, and `node/problems` rejects the old
`[:source]` channel. `arthur.domain.sequence` holds lane validation and the `[:source]` channel. What a lane IS lives in `arthur.domain.symbol` beside the
first three commands — add lane, append drawing, extend hold with explicit other rules about a node map; `arthur.domain.sequence` holds the commands over
ripple and shot-length policy — each one history step. The timeline draws a one — add lane, append drawing, reuse drawing, duplicate drawing, make unique,
lane's occurrences as cel blocks on the lane's own row. and extend hold with explicit ripple and shot-length policy. Each is one history
step, and each refuses rather than half-applying. The timeline draws a lane's
occurrences as cel blocks on the lane's own row, and offers Make unique only
where the selected exposure actually shares its drawing.
Correction layers, the remaining commands (reuse, duplicate, make unique, blank, Content copies are shallow by default and keep their references to other
split, trim, slip, retime) and the exposure-sheet view are not implemented; a symbols; `:deep? true` is the explicit copy that shares nothing, so the promise
refusal is the current behavior where the model demands an explicit choice of independence is only made where it is kept.
nobody has made yet. The suite stands at 392 tests and 5,525 assertions, with
Correction layers, the range and retiming commands (blank, split, trim, move,
slip source, retime) and the exposure-sheet view are not implemented; a refusal
is the current behavior where the model demands an explicit choice nobody has
made yet. The suite stands at 397 tests and 5,561 assertions, with
`frontend/test/browser/sequence.mjs` driving the editor through create, hold, `frontend/test/browser/sequence.mjs` driving the editor through create, hold,
overflow and undo. Rewrite tests that encode superseded behavior rather than overflow, undo, reuse, make unique and duplicate. Rewrite tests that encode
preserving behavior to keep them green. superseded behavior rather than preserving behavior to keep them green.
Build small adversarial documents and test their domain operations before Build small adversarial documents and test their domain operations before
expanding the interface: expanding the interface:

208
frontend/src/arthur/domain/sequence.cljs
View file

@ -1,32 +1,26 @@
(ns arthur.domain.sequence (ns arthur.domain.sequence
"Sequence groups arrange ordinary occurrences. Intervals and property clocks "The commands over a lane of occurrences: make one, put drawings in it, change
have one owner; timeline rows and exposure sheets are projections of them." how long they are exposed, and decide which of them share content.
(:require [arthur.domain.node :as node]))
(defn members [nodes lane] WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a
(->> (vals nodes) node map: a group with `:layout :sequence`, whose children are non-overlapping
(filter #(= lane (:parent %))) visual occurrences. This namespace only changes them.
(sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %))))
vec))
(defn problems [nodes] EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or
(vec `{:refused reason}` — never a half-applied edit, and never a document that
(mapcat `clip/problems` would reject. A command that cannot say what the person meant
(fn [[id lane]] refuses and says why, rather than picking for them: the overflow policy is a
(when (node/sequence? lane) caller's `:extent`, and decoupling shared content is its own command instead
(let [children (filter #(= id (:parent %)) (vals nodes)) of something an ordinary edit does silently.
valid? (fn [n]
(and (= :instance (:kind n)) IDS FOR OCCURRENCES COME FROM THE CALLER, because an occurrence's identity is
(empty? (node/problems n)) a uuid and this namespace is pure. Ids for new CONTENT are derived from the
(:span n) drawing being copied — `clip/free-id` is pure too, and `drawing-a-2` says what
(every? node/finite-number? (node/placed-span n)))) it came from in a way `symbol-7` does not."
intervals (sort-by first (map node/placed-span (filter valid? children)))] (:require [arthur.domain.bring :as bring]
(concat [arthur.domain.clip :as clip]
(for [n children :when (not (valid? n))] [arthur.domain.node :as node]
(str "sequence " id " needs finite visual occurrences: " (:id n))) [arthur.domain.symbol :as symbol]))
(when (some (fn [[[a b] [c d]]] (> b c)) (partition 2 1 intervals))
[(str "sequence " id " has overlapping occurrences")])))))
nodes)))
(defn- lane-map (defn- lane-map
"Lane -> containing symbol, as an invertible map in the opposite direction. "Lane -> containing symbol, as an invertible map in the opposite direction.
@ -43,14 +37,14 @@
(defn- finish (defn- finish
[clip sid nodes selection extent] [clip sid nodes selection extent]
(let [sym (get-in clip [:symbols sid]) (let [sym (clip/symbol clip sid)
changed (for [[id n] nodes :when (node/sequence? n) changed (for [[id n] nodes :when (node/sequence? n)
child (members nodes id) child (symbol/sequence-members nodes id)
:let [m (lane-map nodes id) :let [m (lane-map nodes id)
end (second (node/placed-span child))]] end (second (node/placed-span child))]]
(when m (+ (:at m) (/ end (:rate m))))) (when m (+ (:at m) (/ end (:rate m)))))
end (apply max (:frames sym) (keep identity changed)) end (apply max (:frames sym) (keep identity changed))
ps (problems nodes)] ps (symbol/problems (assoc sym :nodes nodes))]
(cond (cond
(seq ps) {:refused (first ps)} (seq ps) {:refused (first ps)}
(not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"} (not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"}
@ -72,10 +66,14 @@
lane (get nodes (:parent n)) lane (get nodes (:parent n))
rate (:rate (node/time-of n)) rate (:rate (node/time-of n))
span (:span n) span (:span n)
m (when lane (lane-map nodes (:id lane)))] m (when lane (lane-map nodes (:id lane)))
;; The LANE's own shape, not the whole symbol's: refusing an exposure
;; edit over some unrelated defect elsewhere in the symbol would be
;; this command answering for a part of the document it never touches.
broken (first (symbol/sequence-problems nodes))]
(cond (cond
(not (node/sequence? lane)) {:refused "select an occurrence in a sequence lane"} (not (node/sequence? lane)) {:refused "select an occurrence in a sequence lane"}
(seq (problems nodes)) {:refused (first (problems nodes))} broken {:refused broken}
(not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of lane frames"} (not (and (integer? delta) (not (zero? delta)))) {:refused "hold change must be a nonzero whole number of lane frames"}
(not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"} (not (zero? (:speed (node/playback-of n)))) {:refused "hold length applies to a held drawing"}
(nil? m) {:refused "exposure timing through a stepped or looping lane is not supported"} (nil? m) {:refused "exposure timing through a stepped or looping lane is not supported"}
@ -83,7 +81,7 @@
:else :else
(let [[_ boundary] (node/placed-span n) (let [[_ boundary] (node/placed-span n)
later (filter #(>= (first (node/placed-span %)) boundary) later (filter #(>= (first (node/placed-span %)) boundary)
(members nodes (:id lane))) (symbol/sequence-members nodes (:id lane)))
nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta))) nodes (assoc-in nodes [id :span 1] (+ (second span) (* rate delta)))
nodes (reduce (fn [ns sibling] nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) (update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
@ -91,32 +89,138 @@
(finish clip sid nodes id extent))))) (finish clip sid nodes id extent)))))
(defn add-lane [clip sid id] (defn add-lane [clip sid id]
(if (or (nil? (get-in clip [:symbols sid])) (get-in clip [:symbols sid :nodes id])) (if (or (nil? (clip/symbol clip sid)) (get-in clip [:symbols sid :nodes id]))
{:refused "the symbol is missing or the lane ID is already used"} {:refused "the symbol is missing or the lane ID is already used"}
{:clip (assoc-in clip [:symbols sid :nodes id] {:clip (assoc-in clip [:symbols sid :nodes id]
{:id id :name "drawings" :kind :group :layout :sequence {:id id :name "drawings" :kind :group :layout :sequence
:z (str "z-" id)}) :z (str "z-" id)})
:selection id})) :selection id}))
(defn append-drawing ;; ---------------------------------------------------------------------------
"Append fresh one-frame content and a held occurrence. IDs come from the ;; putting drawings in a lane
caller so a command is deterministic and replayable."
[clip sid lane-id id drawing-id {:keys [extent] :or {extent :keep}}] (defn- held
"A one-frame held occurrence of `drawing-id`, starting at lane frame `at`.
Held rather than playing, and one frame rather than the length of what it
places: an exposure's duration is the lane's business — `extend-hold` is how
it changes — and reading it off the content would make placing a ten-frame
animation and holding its first drawing the same gesture."
[id lane-id drawing-id at]
{:id id :kind :instance :parent lane-id :z (str "a-" id)
:span [0 1] :time {:at at :rate 1}
:source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}})
(defn- append
"Put a held occurrence of `drawing-id` after everything already in `lane-id`.
`:frame` in the result is where it lands, for a caller that wants to look at
what it just made."
[clip sid lane-id id drawing-id extent]
(let [nodes (get-in clip [:symbols sid :nodes])
at (apply max 0 (map #(second (node/placed-span %))
(symbol/sequence-members nodes lane-id)))
result (finish clip sid (assoc nodes id (held id lane-id drawing-id at)) id extent)
m (lane-map nodes lane-id)]
(cond-> result
(:clip result) (assoc :frame (+ (:at m) (/ at (:rate m)))))))
(defn- appendable
"Why a held occurrence cannot go into `lane-id`, or nil."
[clip sid lane-id id]
(let [nodes (get-in clip [:symbols sid :nodes]) (let [nodes (get-in clip [:symbols sid :nodes])
lane (get nodes lane-id)] lane (get nodes lane-id)]
(cond (cond
(not (node/sequence? lane)) {:refused "select a sequence lane"} (not (node/sequence? lane)) "select a sequence lane"
(seq (problems nodes)) {:refused (first (problems nodes))} (contains? nodes id) "the new occurrence ID is already used"
(or (contains? nodes id) (get-in clip [:symbols drawing-id])) {:refused "the new drawing IDs are already used"} (nil? (lane-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported"
(nil? (lane-map nodes lane-id)) {:refused "drawing creation through a stepped or looping lane is not supported"} :else (first (symbol/sequence-problems nodes)))))
:else
(let [at (apply max 0 (map #(second (node/placed-span %)) (members nodes lane-id))) (defn append-drawing
n {:id id :kind :instance :parent lane-id :z (str "a-" id) "Append fresh empty content and a held occurrence of it. IDs come from the
:span [0 1] :time {:at at :rate 1} caller so a command is deterministic and replayable.
:source {:symbol drawing-id} :playback {:in 0 :speed 0 :end :stop}}
clip (assoc-in clip [:symbols drawing-id] Fresh content, not a blank range: a lane with no occurrence over a frame shows
{:id drawing-id :name (name drawing-id) :frames 1 :nodes {}})] nothing there already, and a drawing nobody has drawn in is a different thing
(let [result (finish clip sid (assoc nodes id n) id extent) from a gap."
m (lane-map nodes lane-id)] [clip sid lane-id id drawing-id {:keys [extent] :or {extent :keep}}]
(cond-> result (if-let [why (or (appendable clip sid lane-id id)
(:clip result) (assoc :frame (+ (:at m) (/ at (:rate m)))))))))) (when (clip/symbol clip drawing-id) "the new drawing ID is already used"))]
{:refused why}
(append (assoc-in clip [:symbols drawing-id]
{:id drawing-id :name (name drawing-id) :frames 1 :nodes {}})
sid lane-id id drawing-id extent)))
(defn reuse-drawing
"Append a held occurrence of content the document ALREADY has, so the same
drawing is exposed twice and editing it changes both exposures.
This is the command `make-unique` is the undo of, and the reason they are two
commands: reuse is a decision to share, and sharing is not something to
discover later when an edit turns up somewhere else."
[clip sid lane-id id drawing-id {:keys [extent] :or {extent :keep}}]
(if-let [why (or (appendable clip sid lane-id id)
(when-not (clip/symbol clip drawing-id) "there is no such drawing to reuse")
;; Placing something that contains this symbol would close a
;; loop, and a lane is no different from any other placement.
(when (clip/contains-symbol? clip drawing-id sid)
"a symbol cannot go inside itself"))]
{:refused why}
(append clip sid lane-id id drawing-id extent)))
(defn- copied
"A copy of symbol `from`, as `{:clip :id}`.
SHALLOW by default: its own nodes and channels are copied, and its references
to other symbols are kept, so a head built out of reusable eyes still uses
those eyes. `deep?` copies everything it places as well, with new ids
throughout, for a drawing that must share nothing — the distinction the
shallow copy cannot make on its own, and a promise of independence that only
the deep one keeps."
[clip from deep?]
(if deep?
(let [{c :clip ids :ids} (bring/symbols clip clip [from] {})]
{:clip c :id (ids from)})
(let [id (clip/free-id (:symbols clip) from)]
{:clip (assoc-in clip [:symbols id] (assoc (clip/symbol clip from) :id id))
:id id})))
(defn duplicate-drawing
"Append a held occurrence of a COPY of what occurrence `id` places, for when
the drawing on screen is the starting point for the next one.
The copy is of the content only. The new exposure is a plain one-frame hold
rather than a copy of `id`'s own transform or corrections: those belong to
that exposure, and carrying them over would make duplicating a drawing quietly
duplicate the treatment of one use of it."
[clip sid id new-id {:keys [extent deep?] :or {extent :keep}}]
(let [n (get-in clip [:symbols sid :nodes id])
from (node/source n)]
(if-let [why (or (when-not from "select an occurrence to duplicate")
(when-not (clip/symbol clip from) "the drawing it places is missing")
(appendable clip sid (:parent n) new-id))]
{:refused why}
(let [{c :clip copy :id} (copied clip from deep?)]
(append c sid (:parent n) new-id copy extent)))))
(defn make-unique
"Point occurrence `id` at a private copy of its content, leaving every other
occurrence of that drawing sharing the original.
Refused when nothing else uses it: a drawing with one exposure is already
unique, and answering with a silent copy would leave a second identical symbol
in the library for no reason a person could see."
[clip sid id {:keys [deep?]}]
(let [n (get-in clip [:symbols sid :nodes id])
from (node/source n)
elsewhere (for [[osid osym] (:symbols clip)
[oid on] (:nodes osym)
:when (and (= from (node/source on)) (not= [sid id] [osid oid]))]
[osid oid])]
(if-let [why (or (when-not from "select an occurrence to make unique")
(when-not (clip/symbol clip from) "the drawing it places is missing")
(when (empty? elsewhere) "nothing else uses this drawing"))]
{:refused why}
(let [{c :clip copy :id} (copied clip from deep?)
c (assoc-in c [:symbols sid :nodes id :source :symbol] copy)
ps (clip/problems c)]
(if (seq ps) {:refused (first ps)} {:clip c :selection id})))))

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

@ -55,7 +55,6 @@
fill in the same channel rather than convert into a second format." fill in the same channel rather than convert into a second format."
(:require [arthur.domain.channel :as ch] (:require [arthur.domain.channel :as ch]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.sequence :as sequence]
[arthur.domain.pose :as pose] [arthur.domain.pose :as pose]
[arthur.domain.trace :as trace] [arthur.domain.trace :as trace]
[arthur.domain.palette :as pal])) [arthur.domain.palette :as pal]))
@ -91,6 +90,47 @@
[nodes id] [nodes id]
(dec (count (lineage nodes id)))) (dec (count (lineage nodes id))))
(defn sequence-members
"The occurrences of lane `lane`, in the order they are exposed.
Sorted by where they START, not by `:z`: a lane's blocks follow one another in
time, and two of them cannot be in the same place for `:z` to decide between.
Ties go to the id so the order is the same on every run."
[nodes lane]
(->> (vals nodes)
(filter #(= lane (:parent %)))
(sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %))))
vec))
(defn sequence-problems
"What makes a lane not a lane. A SEQUENCE is the one composition rule the node
map carries — ordinary groups compose freely — so it is checked here, beside
the parent and stencil references, rather than wherever a command happens to
build one.
Occurrences must be visual, finite and non-overlapping. An accidental overlap
is refused rather than resolved by draw order: two drawings exposed on one
frame of one lane is a document nobody meant to write, and picking a winner
would hide it. Empty lanes are valid — a lane is made before it is filled."
[nodes]
(vec
(mapcat
(fn [[id lane]]
(when (node/sequence? lane)
(let [children (filter #(= id (:parent %)) (vals nodes))
valid? (fn [n]
(and (= :instance (:kind n))
(empty? (node/problems n))
(:span n)
(every? node/finite-number? (node/placed-span n))))
intervals (sort-by first (map node/placed-span (filter valid? children)))]
(concat
(for [n children :when (not (valid? n))]
(str "sequence " id " needs finite visual occurrences: " (:id n)))
(when (some (fn [[[_ b] [c _]]] (> b c)) (partition 2 1 intervals))
[(str "sequence " id " has overlapping occurrences")])))))
nodes)))
(defn order (defn order
"Node ids in topological order: every node after its parent. "Node ids in topological order: every node after its parent.
@ -573,7 +613,7 @@
(if-not (map? nodes) (if-not (map? nodes)
[":nodes must be a map of id -> node"] [":nodes must be a map of id -> node"]
(-> [] (-> []
(into (sequence/problems nodes)) (into (sequence-problems nodes))
(into (for [[id n] nodes (into (for [[id n] nodes
:when (not= id (:id n))] :when (not= id (:id n))]
(str "node under key " (pr-str id) " has :id " (pr-str (:id n))))) (str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))

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

@ -58,21 +58,64 @@
sid (get-in db [:ui :open])] sid (get-in db [:ui :open])]
(apply-sequence-command db sid (sequence/add-lane clip sid (random-uuid)) nil)))) (apply-sequence-command db sid (sequence/add-lane clip sid (random-uuid)) nil))))
(defn- committed
"One appending command, as effects: commit it, and look at what it made.
Seeking is the whole reason these are `-fx` events. A new exposure lands after
everything already in the lane, which is usually off the playhead, and a
drawing you cannot see is not one you can draw in."
[db sid result retry]
(let [{clip :clip st :store} (store/entry (:clip/current db))
path (nth (get-in db [:ui :selection]) 3 nil)
{:keys [at rate]} (:time (nest/inside clip st (get-in db [:ui :open])
(if (seq path) (pop path) [])
(get-in db [:playback :frame])))]
(cond-> {:db (apply-sequence-command db sid result retry)}
(and (:clip result) (:frame result) rate)
(assoc :dispatch [::playback/seek (+ at (/ (:frame result) rate))]))))
(defn- selected-lane
"The lane a command should act in: the selected lane itself, or the one
holding the selected occurrence."
[clip sid id]
(let [n (get-in clip [:symbols sid :nodes id])]
(if (node/sequence? n) id (:parent n))))
(rf/reg-event-fx (rf/reg-event-fx
::append-drawing ::append-drawing
(fn [{:keys [db]} [_ extent]] (fn [{:keys [db]} [_ extent]]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (let [clip (:clip (store/entry (:clip/current db)))
[_ sid id path] (get-in db [:ui :selection]) [_ sid id] (get-in db [:ui :selection])
n (get-in clip [:symbols sid :nodes id]) result (sequence/append-drawing clip sid (selected-lane clip sid id)
lane (if (node/sequence? n) id (:parent n)) (random-uuid) (clip/fresh-id clip)
result (sequence/append-drawing clip sid lane (random-uuid) (clip/fresh-id clip) {:extent (or extent :keep)})]
{:extent (or extent :keep)}) (committed db sid result [::append-drawing :grow-symbol]))))
context (nest/inside clip st (get-in db [:ui :open]) (if (seq path) (pop path) [])
(get-in db [:playback :frame])) (rf/reg-event-fx
{:keys [at rate]} (:time context)] ::reuse-drawing
(cond-> {:db (apply-sequence-command db sid result [::append-drawing :grow-symbol])} (fn [{:keys [db]} [_ extent]]
(and (:clip result) rate) (let [clip (:clip (store/entry (:clip/current db)))
(assoc :dispatch [::playback/seek (+ at (/ (:frame result) rate))]))))) [_ sid id] (get-in db [:ui :selection])
result (sequence/reuse-drawing clip sid (selected-lane clip sid id) (random-uuid)
(node/source (get-in clip [:symbols sid :nodes id]))
{:extent (or extent :keep)})]
(committed db sid result [::reuse-drawing :grow-symbol]))))
(rf/reg-event-fx
::duplicate-drawing
(fn [{:keys [db]} [_ extent deep?]]
(let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])
result (sequence/duplicate-drawing clip sid id (random-uuid)
{:extent (or extent :keep) :deep? deep?})]
(committed db sid result [::duplicate-drawing :grow-symbol deep?]))))
(rf/reg-event-db
::make-unique
(fn [db [_ deep?]]
(let [clip (:clip (store/entry (:clip/current db)))
[_ sid id] (get-in db [:ui :selection])]
(apply-sequence-command db sid (sequence/make-unique clip sid id {:deep? deep?}) nil))))
(rf/reg-event-db (rf/reg-event-db
::extend-hold ::extend-hold

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

@ -23,7 +23,6 @@
(:require [clojure.string :as str] (:require [clojure.string :as str]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.sequence :as sequence]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace] [arthur.domain.trace :as trace]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
@ -158,7 +157,7 @@
:source (node/source child) :source (node/source child)
:span (mapv self (node/placed-span child)) :span (mapv self (node/placed-span child))
:select [:node sid (:id child) (conj path (:id child))]}) :select [:node sid (:id child) (conj path (:id child))]})
(sequence/members (:nodes sym) id))))] (symbol/sequence-members (:nodes sym) id))))]
(if-not open? (if-not open?
[row] [row]
(-> [row] (-> [row]
@ -230,7 +229,14 @@
n (get-in clip [:symbols sid :nodes id]) n (get-in clip [:symbols sid :nodes id])
lane (if (node/sequence? n) n (get-in clip [:symbols sid :nodes (:parent n)])) lane (if (node/sequence? n) n (get-in clip [:symbols sid :nodes (:parent n)]))
lane? (node/sequence? lane) lane? (node/sequence? lane)
held? (and lane? (= :instance (:kind n)) (zero? (:speed (node/playback-of n))))] cel? (and lane? (= :instance (:kind n)) (some? (node/source n)))
held? (and cel? (zero? (:speed (node/playback-of n))))
;; Shared use is shown rather than discovered: the button that decouples
;; an exposure is only offered where there is something to decouple from.
shared? (and cel? (< 1 (count (for [[_ sym] (:symbols clip)
[_ other] (:nodes sym)
:when (= (node/source n) (node/source other))]
other))))]
[:div.pane-head [:div.pane-head
[:button {:on-click #(rf/dispatch [::pb/toggle])} (if playing? "pause" "play")] [:button {:on-click #(rf/dispatch [::pb/toggle])} (if playing? "pause" "play")]
[:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"] [:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"]
@ -256,6 +262,15 @@
[:button {:disabled (not lane?) [:button {:disabled (not lane?)
:title "append a new independent drawing to the selected lane" :title "append a new independent drawing to the selected lane"
:on-click #(rf/dispatch [::ui/append-drawing])} "new drawing"] :on-click #(rf/dispatch [::ui/append-drawing])} "new drawing"]
[:button {:disabled (not cel?)
:title "expose this same drawing again — one drawing, two exposures"
:on-click #(rf/dispatch [::ui/reuse-drawing])} "reuse"]
[:button {:disabled (not cel?)
:title "append a copy of this drawing, to draw the next one over it"
:on-click #(rf/dispatch [::ui/duplicate-drawing])} "duplicate"]
[:button {:disabled (not shared?)
:title "give this exposure its own copy; other exposures keep sharing"
:on-click #(rf/dispatch [::ui/make-unique])} "make unique"]
[:button {:disabled (not held?) [:button {:disabled (not held?)
:title "shorten this exposure; ripple later drawings, keeping lane keys fixed" :title "shorten this exposure; ripple later drawings, keeping lane keys fixed"
:on-click #(rf/dispatch [::ui/extend-hold -1])} "hold −"] :on-click #(rf/dispatch [::ui/extend-hold -1])} "hold −"]

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

@ -236,3 +236,101 @@
(is (nil? (:clip result))) (is (nil? (:clip result)))
(is (= 15 (get-in (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol}) (is (= 15 (get-in (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol})
[:clip :symbols :main :frames]))))) [:clip :symbols :main :frames])))))
(deftest reuse-shares-content-and-make-unique-decouples-one-exposure
(let [doc (document)
shared (:clip (sequence/reuse-drawing doc :main :girl :c :drawing-a
{:extent :grow-symbol}))
edit (fn [c sym x]
(assoc-in c [:symbols sym :nodes :mark :channels [:xform :pos]]
(ch/framed [x 0])))]
(is (:refused (sequence/reuse-drawing doc :main :girl :c :drawing-a {}))
"the shot has to be extended on purpose")
(is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes :c]))))
(is (= [12 13] (node/placed-span (get-in shared [:symbols :main :nodes :c]))))
(is (empty? (clip/problems shared)))
;; One drawing, two exposures: the edit arrives at both.
(let [at (sample (edit shared :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 99 (get-in at [12 [:c :mark]]))))
(let [unique (:clip (sequence/make-unique shared :main :c {}))]
(is (= :drawing-a-2 (node/source (get-in unique [:symbols :main :nodes :c]))))
(is (= (:nodes (get-in shared [:symbols :drawing-a]))
(:nodes (get-in unique [:symbols :drawing-a-2])))
"a copy of the same drawing, not an empty one")
(is (= :drawing-a (node/source (get-in unique [:symbols :main :nodes :a])))
"the other exposure keeps the original")
(let [at (sample (edit unique :drawing-a 99) [0 12])]
(is (= 99 (get-in at [0 [:a :mark]])))
(is (= 10 (get-in at [12 [:c :mark]])) "the exposure made unique is untouched"))
(let [at (sample (edit unique :drawing-a-2 99) [0 12])]
(is (= 10 (get-in at [0 [:a :mark]])) "and does not reach back"))
(is (empty? (clip/problems unique))))
;; Nothing else places drawing-b, so there is nothing to decouple from.
(is (:refused (sequence/make-unique doc :main :b {})))
(is (:refused (sequence/make-unique doc :main :girl {}))
"a lane places nothing itself")))
(deftest duplicate-copies-the-drawing-and-not-the-exposure
(let [doc (document)
made (:clip (sequence/duplicate-drawing doc :main :b :d {:extent :grow-symbol}))
n (get-in made [:symbols :main :nodes :d])]
(is (= :drawing-b-2 (node/source n)))
(is (= (:nodes (get-in doc [:symbols :drawing-b]))
(:nodes (get-in made [:symbols :drawing-b-2]))))
(is (= [12 13] (node/placed-span n)))
(is (= {:in 0 :speed 0 :end :stop} (:playback n)))
(is (nil? (:channels n)) "B's own position correction belongs to B's exposure")
(is (= (get-in doc [:symbols :main :nodes :b])
(get-in made [:symbols :main :nodes :b]))
"the drawing duplicated is left as it was")
(is (empty? (clip/problems made)))))
(deftest a-shallow-copy-keeps-its-parts-and-a-deep-copy-owns-them
;; A drawing assembled from another symbol: copying it shallowly must keep
;; using that part, and only an explicit deep copy may promise independence.
(let [doc (assoc-in (document) [: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}})
copy (fn [opts] (:clip (sequence/duplicate-drawing
doc :main :a :d (merge {:extent :grow-symbol} opts))))
shallow (copy {})
deep (copy {:deep? true})]
(is (= :wave (node/source (get-in shallow [:symbols :drawing-a-2 :nodes :part]))))
(is (nil? (get-in shallow [:symbols :wave-2])))
(is (= :wave-2 (node/source (get-in deep [:symbols :drawing-a-2 :nodes :part]))))
(is (= (:nodes (get-in doc [:symbols :wave])) (:nodes (get-in deep [:symbols :wave-2]))))
(is (empty? (clip/problems shallow)))
(is (empty? (clip/problems deep)))))
(deftest reuse-refuses-what-would-not-be-a-document
(let [doc (document)]
(is (:refused (sequence/reuse-drawing doc :main :girl :c :nothing-here {})))
(is (:refused (sequence/reuse-drawing doc :main :girl :c :main {:extent :grow-symbol}))
"a symbol cannot go inside itself")
(is (:refused (sequence/reuse-drawing doc :main :girl :a :drawing-a {:extent :grow-symbol}))
"an occurrence ID in use is not free")
(is (:refused (sequence/reuse-drawing doc :main :plate :c :drawing-a {})))
(is (:refused (sequence/duplicate-drawing doc :main :girl :d {})))))
(deftest drawing-on-twos-does-not-quantize-the-lane-transform
;; Exposure length IS the drawing cadence, and it is the only thing on twos
;; here: the lane's transform has its own clock and keeps moving every frame.
;; Stepping it would be the cel cadence leaking into continuous motion.
(let [cel (fn [id source at] (occurrence id source at 2 0))
doc (-> (document)
(update-in [:symbols :main :nodes] dissoc :a :b :insert)
(update-in [:symbols :main :nodes] merge
{:c0 (cel :c0 :drawing-a 0)
:c1 (cel :c1 :drawing-b 2)
:c2 (cel :c2 :drawing-a 4)}))
xs {:c0 10 :c1 20 :c2 10}
at (sample doc (range 6))
showing (fn [f] (first (dissoc (at f) :plate)))]
(is (empty? (clip/problems doc)))
(is (= [:c0 :c0 :c1 :c1 :c2 :c2] (mapv #(first (key (showing %))) (range 6)))
"the drawing showing changes every second frame")
(is (= [0 10 20 30 40 50]
(mapv (fn [f] (let [[[id _] cx] (showing f)] (- cx (xs id)))) (range 6)))
"and the lane moves on every frame, odd ones included")))

38
frontend/test/browser/sequence.mjs
View file

@ -113,8 +113,44 @@ try {
await evaluate(`document.dispatchEvent(new KeyboardEvent('keydown', {key:'z', ctrlKey:true, bubbles:true}))`); await evaluate(`document.dispatchEvent(new KeyboardEvent('keydown', {key:'z', ctrlKey:true, bubbles:true}))`);
await sleep(250); await sleep(250);
assert.deepEqual((await shot()).clip, before.clip, 'one undo restores exposure, ripple, and shot length'); assert.deepEqual((await shot()).clip, before.clip, 'one undo restores exposure, ripple, and shot length');
// Sharing: one drawing exposed twice, then one exposure decoupled. Room is
// made first so these assertions are about content and not about overflow.
await evaluate(`(() => {
const k = cljs.core.keyword, db = cljs.core.deref(re_frame.db.app_db);
arthur.footage.store.edit_clip_BANG_(cljs.core.get(db, k('clip/current')),
clip => cljs.core.assoc_in(clip, cljs.core.vector(k('symbols'), k('main'), k('frames')), 20));
document.querySelector('.tl-cel').click();
})()`);
await sleep(200);
const enabled = async label => await evaluate(`(() => {
const b = [...document.querySelectorAll('button')].find(b => b.textContent.trim() === ${JSON.stringify(label)});
return !!b && !b.disabled;
})()`);
assert.equal(await enabled('make unique'), false, 'nothing to decouple from yet');
await click('reuse');
s = await shot();
let cels = instances(s);
assert.equal(cels.length, 3);
assert.equal(cels[2].source.symbol, cels[0].source.symbol, 'reuse exposes the same drawing');
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 3);
assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1,
'three exposures, still one row');
assert.equal(await enabled('make unique'), true);
await click('make unique');
s = await shot();
cels = instances(s);
assert.notEqual(cels[2].source.symbol, cels[0].source.symbol, 'that exposure has its own drawing');
assert.equal(await enabled('make unique'), false, 'and is not shared any more');
await click('duplicate');
s = await shot();
cels = instances(s);
assert.equal(cels.length, 4);
assert.equal(new Set(cels.map(n => n.source.symbol)).size, 4,
'four exposures of four drawings: nothing is shared once every copy is made');
assert.equal(s.history.done.length, before.history.done.length + 3, 'three more commands, three more steps');
assert.equal(errors.length, 0, JSON.stringify(errors)); assert.equal(errors.length, 0, JSON.stringify(errors));
console.log('PASS: create lane/drawings, one-row cels, hold ripple, seek, explicit overflow, atomic undo; no server writes'); console.log('PASS: create lane/drawings, one-row cels, hold ripple, seek, explicit overflow, atomic undo, reuse/make unique/duplicate; no server writes');
} finally { } finally {
if (ws?.readyState === WebSocket.OPEN) { if (ws?.readyState === WebSocket.OPEN) {
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' })); ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' }));