Reuse, duplicate and make unique: deciding what is shared
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
parent
3d3c1bbca0
commit
9446829774
7 changed files with 427 additions and 83 deletions
|
|
@ -1,32 +1,26 @@
|
|||
(ns arthur.domain.sequence
|
||||
"Sequence groups arrange ordinary occurrences. Intervals and property clocks
|
||||
have one owner; timeline rows and exposure sheets are projections of them."
|
||||
(:require [arthur.domain.node :as node]))
|
||||
"The commands over a lane of occurrences: make one, put drawings in it, change
|
||||
how long they are exposed, and decide which of them share content.
|
||||
|
||||
(defn members [nodes lane]
|
||||
(->> (vals nodes)
|
||||
(filter #(= lane (:parent %)))
|
||||
(sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %))))
|
||||
vec))
|
||||
WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a
|
||||
node map: a group with `:layout :sequence`, whose children are non-overlapping
|
||||
visual occurrences. This namespace only changes them.
|
||||
|
||||
(defn problems [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 [[[a b] [c d]]] (> b c)) (partition 2 1 intervals))
|
||||
[(str "sequence " id " has overlapping occurrences")])))))
|
||||
nodes)))
|
||||
EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or
|
||||
`{:refused reason}` — never a half-applied edit, and never a document that
|
||||
`clip/problems` would reject. A command that cannot say what the person meant
|
||||
refuses and says why, rather than picking for them: the overflow policy is a
|
||||
caller's `:extent`, and decoupling shared content is its own command instead
|
||||
of something an ordinary edit does silently.
|
||||
|
||||
IDS FOR OCCURRENCES COME FROM THE CALLER, because an occurrence's identity is
|
||||
a uuid and this namespace is pure. Ids for new CONTENT are derived from the
|
||||
drawing being copied — `clip/free-id` is pure too, and `drawing-a-2` says what
|
||||
it came from in a way `symbol-7` does not."
|
||||
(:require [arthur.domain.bring :as bring]
|
||||
[arthur.domain.clip :as clip]
|
||||
[arthur.domain.node :as node]
|
||||
[arthur.domain.symbol :as symbol]))
|
||||
|
||||
(defn- lane-map
|
||||
"Lane -> containing symbol, as an invertible map in the opposite direction.
|
||||
|
|
@ -43,14 +37,14 @@
|
|||
|
||||
(defn- finish
|
||||
[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)
|
||||
child (members nodes id)
|
||||
child (symbol/sequence-members nodes id)
|
||||
:let [m (lane-map nodes id)
|
||||
end (second (node/placed-span child))]]
|
||||
(when m (+ (:at m) (/ end (:rate m)))))
|
||||
end (apply max (:frames sym) (keep identity changed))
|
||||
ps (problems nodes)]
|
||||
ps (symbol/problems (assoc sym :nodes nodes))]
|
||||
(cond
|
||||
(seq ps) {:refused (first ps)}
|
||||
(not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"}
|
||||
|
|
@ -72,10 +66,14 @@
|
|||
lane (get nodes (:parent n))
|
||||
rate (:rate (node/time-of 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
|
||||
(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 (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"}
|
||||
|
|
@ -83,7 +81,7 @@
|
|||
:else
|
||||
(let [[_ boundary] (node/placed-span n)
|
||||
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 (reduce (fn [ns sibling]
|
||||
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
|
||||
|
|
@ -91,32 +89,138 @@
|
|||
(finish clip sid nodes id extent)))))
|
||||
|
||||
(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"}
|
||||
{:clip (assoc-in clip [:symbols sid :nodes id]
|
||||
{:id id :name "drawings" :kind :group :layout :sequence
|
||||
:z (str "z-" id)})
|
||||
:selection id}))
|
||||
|
||||
(defn append-drawing
|
||||
"Append fresh one-frame content and a held occurrence. IDs come from the
|
||||
caller so a command is deterministic and replayable."
|
||||
[clip sid lane-id id drawing-id {:keys [extent] :or {extent :keep}}]
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; putting drawings in a lane
|
||||
|
||||
(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])
|
||||
lane (get nodes lane-id)]
|
||||
(cond
|
||||
(not (node/sequence? lane)) {:refused "select a sequence lane"}
|
||||
(seq (problems nodes)) {:refused (first (problems nodes))}
|
||||
(or (contains? nodes id) (get-in clip [:symbols drawing-id])) {:refused "the new drawing IDs are already used"}
|
||||
(nil? (lane-map nodes lane-id)) {:refused "drawing creation through a stepped or looping lane is not supported"}
|
||||
:else
|
||||
(let [at (apply max 0 (map #(second (node/placed-span %)) (members nodes lane-id)))
|
||||
n {: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}}
|
||||
clip (assoc-in clip [:symbols drawing-id]
|
||||
{:id drawing-id :name (name drawing-id) :frames 1 :nodes {}})]
|
||||
(let [result (finish clip sid (assoc nodes id n) id extent)
|
||||
m (lane-map nodes lane-id)]
|
||||
(cond-> result
|
||||
(:clip result) (assoc :frame (+ (:at m) (/ at (:rate m))))))))))
|
||||
(not (node/sequence? lane)) "select a sequence lane"
|
||||
(contains? nodes id) "the new occurrence ID is already used"
|
||||
(nil? (lane-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported"
|
||||
:else (first (symbol/sequence-problems nodes)))))
|
||||
|
||||
(defn append-drawing
|
||||
"Append fresh empty content and a held occurrence of it. IDs come from the
|
||||
caller so a command is deterministic and replayable.
|
||||
|
||||
Fresh content, not a blank range: a lane with no occurrence over a frame shows
|
||||
nothing there already, and a drawing nobody has drawn in is a different thing
|
||||
from a gap."
|
||||
[clip sid lane-id id drawing-id {:keys [extent] :or {extent :keep}}]
|
||||
(if-let [why (or (appendable clip sid lane-id id)
|
||||
(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})))))
|
||||
|
|
|
|||
|
|
@ -55,7 +55,6 @@
|
|||
fill in the same channel rather than convert into a second format."
|
||||
(:require [arthur.domain.channel :as ch]
|
||||
[arthur.domain.node :as node]
|
||||
[arthur.domain.sequence :as sequence]
|
||||
[arthur.domain.pose :as pose]
|
||||
[arthur.domain.trace :as trace]
|
||||
[arthur.domain.palette :as pal]))
|
||||
|
|
@ -91,6 +90,47 @@
|
|||
[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
|
||||
"Node ids in topological order: every node after its parent.
|
||||
|
||||
|
|
@ -573,7 +613,7 @@
|
|||
(if-not (map? nodes)
|
||||
[":nodes must be a map of id -> node"]
|
||||
(-> []
|
||||
(into (sequence/problems nodes))
|
||||
(into (sequence-problems nodes))
|
||||
(into (for [[id n] nodes
|
||||
:when (not= id (:id n))]
|
||||
(str "node under key " (pr-str id) " has :id " (pr-str (:id n)))))
|
||||
|
|
|
|||
|
|
@ -58,21 +58,64 @@
|
|||
sid (get-in db [:ui :open])]
|
||||
(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
|
||||
::append-drawing
|
||||
(fn [{:keys [db]} [_ extent]]
|
||||
(let [{clip :clip st :store} (store/entry (:clip/current db))
|
||||
[_ sid id path] (get-in db [:ui :selection])
|
||||
n (get-in clip [:symbols sid :nodes id])
|
||||
lane (if (node/sequence? n) id (:parent n))
|
||||
result (sequence/append-drawing clip sid lane (random-uuid) (clip/fresh-id clip)
|
||||
{:extent (or extent :keep)})
|
||||
context (nest/inside clip st (get-in db [:ui :open]) (if (seq path) (pop path) [])
|
||||
(get-in db [:playback :frame]))
|
||||
{:keys [at rate]} (:time context)]
|
||||
(cond-> {:db (apply-sequence-command db sid result [::append-drawing :grow-symbol])}
|
||||
(and (:clip result) rate)
|
||||
(assoc :dispatch [::playback/seek (+ at (/ (:frame result) rate))])))))
|
||||
(let [clip (:clip (store/entry (:clip/current db)))
|
||||
[_ sid id] (get-in db [:ui :selection])
|
||||
result (sequence/append-drawing clip sid (selected-lane clip sid id)
|
||||
(random-uuid) (clip/fresh-id clip)
|
||||
{:extent (or extent :keep)})]
|
||||
(committed db sid result [::append-drawing :grow-symbol]))))
|
||||
|
||||
(rf/reg-event-fx
|
||||
::reuse-drawing
|
||||
(fn [{:keys [db]} [_ extent]]
|
||||
(let [clip (:clip (store/entry (:clip/current db)))
|
||||
[_ 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
|
||||
::extend-hold
|
||||
|
|
|
|||
|
|
@ -23,7 +23,6 @@
|
|||
(:require [clojure.string :as str]
|
||||
[arthur.domain.node :as node]
|
||||
[arthur.domain.nest :as nest]
|
||||
[arthur.domain.sequence :as sequence]
|
||||
[arthur.domain.symbol :as symbol]
|
||||
[arthur.domain.trace :as trace]
|
||||
[arthur.events.playback :as pb]
|
||||
|
|
@ -158,7 +157,7 @@
|
|||
:source (node/source child)
|
||||
:span (mapv self (node/placed-span child))
|
||||
:select [:node sid (:id child) (conj path (:id child))]})
|
||||
(sequence/members (:nodes sym) id))))]
|
||||
(symbol/sequence-members (:nodes sym) id))))]
|
||||
(if-not open?
|
||||
[row]
|
||||
(-> [row]
|
||||
|
|
@ -230,7 +229,14 @@
|
|||
n (get-in clip [:symbols sid :nodes id])
|
||||
lane (if (node/sequence? n) n (get-in clip [:symbols sid :nodes (:parent n)]))
|
||||
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
|
||||
[:button {:on-click #(rf/dispatch [::pb/toggle])} (if playing? "pause" "play")]
|
||||
[:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"]
|
||||
|
|
@ -256,6 +262,15 @@
|
|||
[:button {:disabled (not lane?)
|
||||
:title "append a new independent drawing to the selected lane"
|
||||
: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?)
|
||||
:title "shorten this exposure; ripple later drawings, keeping lane keys fixed"
|
||||
:on-click #(rf/dispatch [::ui/extend-hold -1])} "hold −"]
|
||||
|
|
|
|||
|
|
@ -236,3 +236,101 @@
|
|||
(is (nil? (:clip result)))
|
||||
(is (= 15 (get-in (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol})
|
||||
[: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")))
|
||||
|
|
|
|||
|
|
@ -113,8 +113,44 @@ try {
|
|||
await evaluate(`document.dispatchEvent(new KeyboardEvent('keydown', {key:'z', ctrlKey:true, bubbles:true}))`);
|
||||
await sleep(250);
|
||||
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));
|
||||
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 {
|
||||
if (ws?.readyState === WebSocket.OPEN) {
|
||||
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' }));
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue