An occurrence is a node, with a clock of its own
A lane's drawings were going to be one instance whose source was a KEYED
channel: frame 0 says `:drawing-a`, frame 4 says `:drawing-b`, and the cels of
a row are that channel's keys. Two things followed from it, and both were
wrong.
The first is that playback meant whichever shape the channel happened to have.
A framed source played its symbol; a keyed source froze the selected frame.
So `node/placed-at` read animation out of storage, and adding an ordinary key
to a still turned it into an animation — the last-key bug, which was not a bug
in the code so much as the rule working as written. But WHICH drawing is used
and HOW time runs inside it are independent questions, and all four combinations
are ordinary: hold one drawing, play one animation, cut between held drawings,
cut between playing ones.
So an occurrence names one symbol in `:source {:symbol ...}` and says how its
source time advances in `:playback {:in :speed :end}` — `source = in + speed *
f`, a hold being speed 0, with `:stop`, `:hold` or `:loop` at the end named
rather than guessed. `node/placed-frame` samples it forwards, which works for
holds too, and `node/source-time` is the separate, invertible edit map, nil
where inversion is meaningless. The two were one function before, and a hold
had to lie about one of them.
The second is that a keyed source only looked necessary because an occurrence
was assumed to need a ROW. It does not. A lane is a group with `:layout
:sequence`, its occurrences are ordinary instances in the same flat node map,
and `timeline/rows` draws them as cel blocks on the lane's own row: twelve
exposures, one row, each cel still separately selectable and addressable. The
vertical growth that justified the keyed source is a presentation question, and
it is answered in the view.
`arthur.domain.sequence` holds the first commands over that shape — add lane,
append drawing, extend hold — each one history step, each refusing rather than
half-applying. Extending a hold leaves the lane's keys at their authored times,
because you are adjusting drawings underneath timed motion; a correction owned
by an occurrence travels with it. Ownership does that work, so no key needs a
flag saying what it follows. Ripple past the symbol's end is refused with the
frame count it would need, and `:extent :grow-symbol` is the caller saying yes.
`clip/blank` no longer carries `:subjects {} :features {} :groups {}`. Empty
maps write no leaf, so a blank document could not survive its own round trip —
`leaf/leaves` promises exactness and was the only honest side of that.
Documents are schema 3. A version 2 document is not read; nothing here converts
one. `docs/lane-model.md` is the design, and says which of its parts are built.
392 tests, 5,525 assertions, and `test/browser/sequence.mjs` drives the editor
through create, hold, explicit overflow and undo.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Your Name
parent
624242b407
commit
3d3c1bbca0
38 changed files with 1564 additions and 213 deletions
|
|
@ -87,12 +87,16 @@
|
|||
(.then (fn [buffer] [source {:buffer buffer :fps (.-fps manifest)}]))))))))
|
||||
|
||||
(defn- automate! [^js param channel start end fps factor default store]
|
||||
(let [channel (or channel (ch/framed default))]
|
||||
(.setValueAtTime param (* factor (ch/value-at channel start store)) (/ start fps))
|
||||
(let [channel (or channel (ch/framed default))
|
||||
sample (fn [f] (ch/value-at channel
|
||||
(if-let [{:keys [at rate]} (:sample-time channel)]
|
||||
(js/Math.floor (* rate (- f at))) f)
|
||||
store))]
|
||||
(.setValueAtTime param (* factor (sample start)) (/ start fps))
|
||||
(cond
|
||||
(:dense channel)
|
||||
(doseq [f (range (inc start) end)]
|
||||
(.setValueAtTime param (* factor (ch/value-at channel f store)) (/ f fps)))
|
||||
(.setValueAtTime param (* factor (sample f)) (/ f fps)))
|
||||
|
||||
(:animated? channel)
|
||||
(doseq [[f v] (sort-by key (:keys channel))
|
||||
|
|
|
|||
|
|
@ -29,8 +29,10 @@
|
|||
instances of one symbol are seven different things to name — to export on their
|
||||
own, to link a voice to, to point at later — and an id like `:left` is a
|
||||
description of where a thing sits, which is exactly what changes when the stage
|
||||
is re-arranged. `:name` carries the label for a human and `:of` carries the
|
||||
symbol, so the node still says what it is and which drawing it plays."
|
||||
is re-arranged. `:name` carries the label for a human and `:source :symbol`
|
||||
carries the symbol, so the node still says what it is and which drawing it
|
||||
plays — and `:playback` says how time runs inside it, which is a separate
|
||||
question from which drawing that is."
|
||||
[source]
|
||||
(let [{:keys [name width height frames symbol instances audio scale]} layout
|
||||
default-anchor (or (:anchor layout)
|
||||
|
|
@ -49,12 +51,13 @@
|
|||
{:root {:id :root :name "stage" :kind :group :z "a1"}}
|
||||
(map (fn [{:keys [uuid name z span at center anchor drift phase]}]
|
||||
(let [anchor (or anchor default-anchor)]
|
||||
[uuid {:id uuid :name name :kind :instance :of symbol
|
||||
[uuid {:id uuid :name name :kind :instance
|
||||
:parent :root :z z :span span
|
||||
:time {:mode :map :at at :rate 1}
|
||||
:source {:symbol symbol}
|
||||
:channels {[:xform :pos] (if drift
|
||||
(position-track center anchor drift phase frames)
|
||||
(ch/framed (mapv - center anchor)))
|
||||
(position-track center anchor drift phase frames)
|
||||
(ch/framed (mapv - center anchor)))
|
||||
[:xform :anchor] {:animated? false :value anchor}
|
||||
[:xform :scale] scale}}]))
|
||||
instances))
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
so the events that fetch them are only fetching."
|
||||
(:refer-clojure :exclude [take])
|
||||
(:require [arthur.domain.clip :as clip]
|
||||
[arthur.domain.node :as node]
|
||||
[clojure.string :as string]))
|
||||
|
||||
(defn symbols
|
||||
|
|
@ -19,8 +20,8 @@
|
|||
`other` to its id here.
|
||||
|
||||
AN ID THAT IS TAKEN IS RENAMED, never merged: two symbols that happen to share
|
||||
an id are two drawings, and an instance's `:of` inside the copy is rewritten to
|
||||
follow. `wanted` maps a root's id in `other` to the id it should preferably get,
|
||||
an id are two drawings, and an occurrence's `:source :symbol` inside the copy is
|
||||
rewritten to follow. `wanted` maps a root's id in `other` to the id it should preferably get,
|
||||
which is how a symbol made from footage is called what the person typed rather
|
||||
than `:main`.
|
||||
|
||||
|
|
@ -35,12 +36,16 @@
|
|||
(some #{%} (vals ids)))]
|
||||
(assoc ids sid (clip/free-id taken? (get wanted sid sid)))))
|
||||
{} (sort-by str reach))
|
||||
;; Occurrence identity and timing stay put; content references follow
|
||||
;; the symbol IDs assigned in the destination document.
|
||||
repoint (fn [n ids]
|
||||
(if (node/source n)
|
||||
(update-in n [:source :symbol] ids)
|
||||
n))
|
||||
copy (fn [sid]
|
||||
(-> (clip/symbol other sid)
|
||||
(assoc :id (ids sid))
|
||||
(update :nodes #(into {} (map (fn [[id n]]
|
||||
[id (cond-> n (:of n) (update :of ids))]))
|
||||
%))))]
|
||||
(update :nodes #(into {} (map (fn [[id n]] [id (repoint n ids)])) %))))]
|
||||
{:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach)
|
||||
:ids ids}))
|
||||
|
||||
|
|
|
|||
|
|
@ -38,7 +38,8 @@
|
|||
instance is `:rate` on its `:time` map, which is a factor and not a rate. A
|
||||
frame COUNT is a property of a frame space, so every symbol has its own."
|
||||
(:refer-clojure :exclude [symbol])
|
||||
(:require [arthur.domain.feature :as feature]
|
||||
(:require [arthur.domain.channel :as ch]
|
||||
[arthur.domain.feature :as feature]
|
||||
[arthur.domain.node :as node]
|
||||
[arthur.domain.palette :as pal]
|
||||
[arthur.domain.pose :as pose]
|
||||
|
|
@ -84,8 +85,7 @@
|
|||
(defn places
|
||||
"The ids of the symbols `sid` places, directly."
|
||||
[clip sid]
|
||||
(into #{} (keep (fn [n] (when (= :instance (:kind n)) (:of n))))
|
||||
(vals (:nodes (symbol clip sid)))))
|
||||
(into #{} (mapcat node/sources) (vals (:nodes (symbol clip sid)))))
|
||||
|
||||
(defn contains-symbol?
|
||||
"Whether `inner` is `outer` or is placed anywhere inside it. Placing `outer`
|
||||
|
|
@ -124,14 +124,18 @@
|
|||
"A new, empty document: one empty symbol.
|
||||
|
||||
`:nodes` is empty rather than seeded with a layer, because an empty symbol is
|
||||
a true statement and a layer nobody asked for is one more thing to delete. The
|
||||
tracking maps are present and empty for the same reason `clip-keys` exists: a
|
||||
field that is sometimes absent is a field every reader needs a fallback for."
|
||||
a true statement and a layer nobody asked for is one more thing to delete.
|
||||
|
||||
The tracking maps are ABSENT rather than empty, because `leaf/leaves` writes no
|
||||
leaf for an empty one and so cannot bring it back: a blank document that opened
|
||||
as a different map than it saved from is exactly the round trip that namespace
|
||||
promises not to have. Nothing drawn by hand has them either — the demo scene
|
||||
and the swarm carry no `:subjects` — so every reader already reads absence as
|
||||
none, and `clip-keys` says which fields MAY be here, not which must."
|
||||
[]
|
||||
{:name "untitled"
|
||||
:fps 30
|
||||
:width 320 :height 200
|
||||
:subjects {} :features {} :groups {}
|
||||
:symbols {:main {:id :main :frames blank-frames :nodes {}}}})
|
||||
|
||||
(defn- transform-op
|
||||
|
|
@ -186,32 +190,37 @@
|
|||
own (symbol/resolver sym store palette
|
||||
(assoc opts :pose-tracks pose-tracks
|
||||
:source-fps (:fps clip)))
|
||||
;; Each occurrence owns its source resolver and mutable buffers.
|
||||
children (into {}
|
||||
(for [[id n] nodes :when (= :instance (:kind n))]
|
||||
[id (build (:of n) (conj chain sid)
|
||||
(get-in n [:playback :tracks]))]))
|
||||
;; The instances that were on the last frame. Their resolvers
|
||||
;; still hold the frame before whenever they were not.
|
||||
entered (volatile! #{})
|
||||
(for [[id n] nodes
|
||||
:when (= :instance (:kind n))
|
||||
child (sort-by str (node/sources n))]
|
||||
[[id child] (build child (conj chain sid)
|
||||
(get-in n [:playback :tracks]))]))
|
||||
;; The instances that were on the last frame, and WHICH
|
||||
;; drawing each was showing — a row path is read back through
|
||||
;; the child that was actually resolved, not the only one
|
||||
;; there used to be. Their resolvers still hold the frame
|
||||
;; before whenever they were not on.
|
||||
entered (volatile! {})
|
||||
step (fn [f]
|
||||
(vreset! entered #{})
|
||||
(vreset! entered {})
|
||||
(let [by-id (into {} (map (juxt :node identity)) (own f))]
|
||||
(into []
|
||||
(mapcat
|
||||
(fn [id]
|
||||
(let [n (get nodes id)]
|
||||
(if (= :instance (:kind n))
|
||||
(let [m (symbol/world-of own id)
|
||||
(let [m (symbol/world-of own id)
|
||||
local (symbol/frame-of own id)
|
||||
target (symbol clip (:of n))
|
||||
length (:frames target)
|
||||
frame (when (and m (number? local))
|
||||
(if (get-in n [:time :loop?])
|
||||
(mod local length)
|
||||
local))]
|
||||
length (frames clip (node/source n))
|
||||
shown (when (and m (number? local))
|
||||
(node/placed-frame n local length))
|
||||
frame (:frame shown)]
|
||||
(if (and frame (<= 0 frame) (< frame length))
|
||||
(do (vswap! entered conj id)
|
||||
(map #(transform-op % m [id]) ((get children id) frame)))
|
||||
(do (vswap! entered assoc id (:symbol shown))
|
||||
(map #(transform-op % m [id])
|
||||
((get children [id (:symbol shown)]) frame)))
|
||||
[]))
|
||||
(when-let [op (get by-id id)] [op]))))
|
||||
ids))))]
|
||||
|
|
@ -222,13 +231,14 @@
|
|||
(world-of [_ [id & more]]
|
||||
(if more
|
||||
(when-let [w (and (contains? @entered id)
|
||||
(symbol/world-of (get children id) (vec more)))]
|
||||
(symbol/world-of (get children [id (get @entered id)])
|
||||
(vec more)))]
|
||||
(node/mul! (node/mat) (symbol/world-of own id) w))
|
||||
(symbol/world-of own id)))
|
||||
(frame-of [_ [id & more]]
|
||||
(if more
|
||||
(when (contains? @entered id)
|
||||
(symbol/frame-of (get children id) (vec more)))
|
||||
(symbol/frame-of (get children [id (get @entered id)]) (vec more)))
|
||||
(symbol/frame-of own id))))))]
|
||||
(build sid [] nil)))
|
||||
|
||||
|
|
@ -296,13 +306,14 @@
|
|||
{:id uuid
|
||||
:name (symbol-name clip sid)
|
||||
:kind :instance
|
||||
:of sid
|
||||
:parent nil
|
||||
;; Lexicographic draw order, as `domain/paint` does it: a placement made
|
||||
;; later sits above one made earlier, and neither has to renumber.
|
||||
:z (str "z" (js/Date.now) "-" (name sid))
|
||||
:span [0 (:frames target)]
|
||||
:time {:mode :map :at frame :rate 1}
|
||||
:source {:symbol sid}
|
||||
:playback {:in 0 :speed 1 :end :stop}
|
||||
:channels {[:xform :pos] {:animated? false
|
||||
:value (if point (mapv - point middle) [0 0])}
|
||||
[:xform :anchor] {:animated? false :value middle}}})))))
|
||||
|
|
@ -374,22 +385,23 @@
|
|||
(str "symbol " (pr-str id) ": " p))
|
||||
(for [[sid sym] (:symbols clip)
|
||||
[id n] (:nodes sym)
|
||||
:when (and (= :instance (:kind n))
|
||||
(not (contains? (:symbols clip) (:of n))))]
|
||||
:when (= :instance (:kind n))
|
||||
missing (remove (:symbols clip) (node/sources n))]
|
||||
(str "symbol " (pr-str sid) " instance " (pr-str id)
|
||||
" names missing symbol " (pr-str (:of n))))
|
||||
" names missing symbol " (pr-str missing)))
|
||||
;; Pose tracks belong to this occurrence's single source symbol.
|
||||
(for [[sid sym] (:symbols clip)
|
||||
[id n] (:nodes sym)
|
||||
:when (= :instance (:kind n))
|
||||
:let [target (get-in clip [:symbols (:of n)])
|
||||
:let [targets (keep #(get-in clip [:symbols %]) (node/sources n))
|
||||
active (filter (fn [node]
|
||||
(some :pose-sampled? (vals (:channels node))))
|
||||
(vals (:nodes target)))
|
||||
(mapcat #(vals (:nodes %)) targets))
|
||||
groups (set (concat
|
||||
(map #(or (:pose-group %) (:id %)) active)
|
||||
(map #(vector :node (:id %)) active)))]
|
||||
p (pose/problems (get-in n [:playback :tracks])
|
||||
(:frames target) groups)]
|
||||
(apply max 0 (keep :frames targets)) groups)]
|
||||
(str "symbol " (pr-str sid) " instance " (pr-str id) ": " p))
|
||||
(for [[sid sym] (:symbols clip)
|
||||
[id n] (:nodes sym)
|
||||
|
|
|
|||
|
|
@ -61,13 +61,28 @@
|
|||
chain (map #(get nodes %) (rseq (symbol/lineage nodes id)))
|
||||
m (symbol/world-of r id)
|
||||
local (symbol/frame-of r id)
|
||||
inner (get-in nodes [id :of])]
|
||||
inst? (= :instance (:kind (get nodes id)))
|
||||
;; WHICH symbol, and which frame of it, are both read off the
|
||||
;; occurrence: inside a held cel is its drawing on the frame
|
||||
;; the hold pins, not on `local`, and inside a playing insert
|
||||
;; is its animation at its own in-point and speed.
|
||||
shown (when (number? local)
|
||||
(node/placed-frame (get nodes id) local
|
||||
(clip/frames clip (node/source (get nodes id)))))
|
||||
inner (:symbol shown)
|
||||
lf (if shown (:frame shown) local)]
|
||||
(if (and m (number? local)
|
||||
(or (nil? inner) (< -1 local (clip/frames clip inner))))
|
||||
{:sid inner :frame (js/Math.floor local)
|
||||
;; A lane over a gap has no inside to be in.
|
||||
(or (not inst?) shown)
|
||||
(or (nil? inner) (< -1 lf (clip/frames clip inner))))
|
||||
{:sid inner :frame (js/Math.floor lf)
|
||||
:matrix (node/mul! (node/mat) matrix m)
|
||||
:time (when (and time (not-any? #(get-in % [:time :loop?]) chain))
|
||||
(reduce node/then-time time (map node/time-of chain)))}
|
||||
;; Forward sampling above works for holds too. :time is the
|
||||
;; invertible edit map; source in-points and speeds belong in it.
|
||||
:time (when (and time (not-any? #(get-in % [:time :loop?]) chain)
|
||||
(or (not inst?) (node/source-time (get nodes id))))
|
||||
(cond-> (reduce node/then-time time (map node/time-of chain))
|
||||
inst? (node/then-time (node/source-time (get nodes id)))))}
|
||||
(reduced nil))))
|
||||
{:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}}
|
||||
path))
|
||||
|
|
@ -109,41 +124,68 @@
|
|||
(partition 2 pts)))))))
|
||||
|
||||
(defn audio-tracks
|
||||
"Every sound symbol `sid` plays, as audio nodes in `sid`'s own frames: its own
|
||||
and, recursively, those inside the instances it places.
|
||||
|
||||
A sound inside a placed symbol is heard where the instance puts it, so each one
|
||||
is carried OUT through the instance's time map — the same map a timeline row
|
||||
draws with — and cut to the instance's own span, until it is in the frames of
|
||||
the symbol being played. Keyed automation moves with it. What comes back is
|
||||
what a mixer that only knows flat tracks can play as it is."
|
||||
"Flatten audible source intervals through occurrence and parent clocks.
|
||||
A held visual source is silent. Every returned track carries a source offset,
|
||||
an output interval, and automation mapped into the open symbol's time."
|
||||
[clip sid]
|
||||
(let [sym (clip/symbol clip sid)]
|
||||
(into (vec (filter #(= :audio (:kind %)) (vals (:nodes sym))))
|
||||
(mapcat
|
||||
(fn [inst]
|
||||
(let [outer (node/time-of inst)
|
||||
->outer (fn [x] (+ (:at outer) (/ x (:rate outer))))
|
||||
[in out] (or (:span inst) [0 (clip/frames clip (:of inst))])]
|
||||
(keep (fn [a]
|
||||
(let [[p0 p1] (or (node/placed-span a) [in out])
|
||||
x0 (max p0 in)
|
||||
x1 (min p1 out)
|
||||
own (node/time-of a)
|
||||
->own (fn [x] (* (:rate own) (- x (:at own))))
|
||||
world (node/then-time outer own)]
|
||||
(when (< x0 x1)
|
||||
(-> a
|
||||
(assoc :span [(->own x0) (->own x1)]
|
||||
:time {:mode :map :at (:at world) :rate (:rate world)})
|
||||
(update :channels
|
||||
(fn [chs]
|
||||
(into {} (map (fn [[p ch]]
|
||||
[p (cond-> ch (:keys ch)
|
||||
(update :keys #(into {} (map (fn [[f v]] [(->outer f) v])) %)))]))
|
||||
chs)))))))
|
||||
(audio-tracks clip (:of inst)))))
|
||||
(filter #(= :instance (:kind %)) (vals (:nodes sym)))))))
|
||||
(letfn [(to-local [m f] (* (:rate m) (- f (:at m))))
|
||||
(to-outer [m f] (+ (:at m) (/ f (:rate m))))
|
||||
(window [m span bounds]
|
||||
(if span
|
||||
[(max (first bounds) (to-outer m (first span)))
|
||||
(min (second bounds) (to-outer m (second span)))]
|
||||
bounds))
|
||||
(channels [chs m]
|
||||
(into {}
|
||||
(map (fn [[p c]]
|
||||
[p (cond-> c
|
||||
(:keys c) (update :keys #(into {} (map (fn [[f v]] [(to-outer m f) v])) %))
|
||||
(:segments c) (update :segments #(into {} (map (fn [[f v]] [(to-outer m f) v])) %))
|
||||
(:dense c) (assoc :sample-time m))]))
|
||||
chs))
|
||||
(walk [sid outer bounds path seen]
|
||||
(when (contains? seen sid)
|
||||
(throw (ex-info "symbol cycle in audio" {:symbol sid})))
|
||||
(let [sym (clip/symbol clip sid)
|
||||
nodes (:nodes sym)
|
||||
bounds (window outer [0 (:frames sym)] bounds)
|
||||
positions (reduce
|
||||
(fn [acc id]
|
||||
(let [n (get nodes id)
|
||||
parent (if-let [pid (:parent n)] (get acc pid)
|
||||
{:time outer :bounds bounds})
|
||||
m (node/then-time (:time parent) (node/time-of n))]
|
||||
(assoc acc id {:time m :bounds (window m (:span n) (:bounds parent))})))
|
||||
{} (symbol/order nodes))]
|
||||
(mapcat
|
||||
(fn [[id n]]
|
||||
(let [{m :time [lo hi] :bounds} (get positions id)]
|
||||
(when (< lo hi)
|
||||
(case (:kind n)
|
||||
:audio [(-> n
|
||||
(assoc :parent nil :path (conj path id) :owner sid
|
||||
:span [(to-local m lo) (to-local m hi)]
|
||||
:time (merge (:time n) {:mode :map :at (:at m) :rate (:rate m) :offset 0})
|
||||
:channels (channels (:channels n) m)))]
|
||||
:instance
|
||||
(let [{:keys [in speed end]} (node/playback-of n)
|
||||
child (node/source n)
|
||||
length (clip/frames clip child)]
|
||||
;; A visual freeze does not emit a sustained audio sample.
|
||||
(when (and child length (pos? speed))
|
||||
(let [source (node/then-time m {:at (- (/ in speed)) :rate speed})
|
||||
loop? (or (= end :loop) (get-in n [:time :loop?]))
|
||||
periods (if loop?
|
||||
(range (js/Math.floor (/ (to-local source lo) length))
|
||||
(js/Math.ceil (/ (to-local source hi) length)))
|
||||
[0])]
|
||||
(mapcat (fn [period]
|
||||
(let [cycle (update source :at + (/ (* period length) (:rate source)))]
|
||||
(walk child cycle [lo hi] (conj path id) (conj seen sid))))
|
||||
periods))))
|
||||
nil))))
|
||||
(sort-by (comp str key) nodes))))]
|
||||
(vec (walk sid {:at 0 :rate 1} [0 (clip/frames clip sid)] [] #{}))))
|
||||
|
||||
(defn- retime
|
||||
"Node `n` with its own time map replaced by `m`, and nothing else touched: its
|
||||
|
|
@ -184,7 +226,8 @@
|
|||
js/Float64Array.from))]
|
||||
(cond
|
||||
(= host target) {:refused "it is already there"}
|
||||
(and (= :instance (:kind n)) (clip/contains-symbol? clip (:of n) target))
|
||||
(and (= :instance (:kind n))
|
||||
(some #(clip/contains-symbol? clip % target) (node/sources n)))
|
||||
{:refused "a symbol cannot go inside itself"}
|
||||
(some (fn [m] (or (:measured (get nodes m))
|
||||
(some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m))))))
|
||||
|
|
@ -254,7 +297,13 @@
|
|||
there are the same on every frame, so asking needs nothing to be on screen;
|
||||
only a move that keeps the PICTURE needs a frame, for the matrix."
|
||||
[clip sid path]
|
||||
(let [sids (reductions #(get-in clip [:symbols %1 :nodes %2 :of]) sid path)
|
||||
(let [;; Structurally, a row leads into a symbol only where it names one:
|
||||
;; an occurrence does, and the lane holding it does not, so the walk
|
||||
;; stops at a lane rather than picking the drawing showing now — which
|
||||
;; would make where a row lives depend on the playhead.
|
||||
only (fn [sid id]
|
||||
(when sid (node/source (get-in clip [:symbols sid :nodes id]))))
|
||||
sids (reductions only sid path)
|
||||
;; Every node on the way, outermost first: each instance, after its
|
||||
;; parents in the symbol it is in.
|
||||
chain (mapcat (fn [sid id]
|
||||
|
|
@ -262,8 +311,12 @@
|
|||
(map #(get nodes %) (rseq (symbol/lineage nodes id)))))
|
||||
sids path)]
|
||||
{:sid (last sids)
|
||||
:time (when (not-any? #(get-in % [:time :loop?]) chain)
|
||||
(reduce node/then-time {:at 0 :rate 1} (map node/time-of chain)))}))
|
||||
:time (when (not-any? #(or (get-in % [:time :loop?])
|
||||
(and (= :instance (:kind %)) (nil? (node/source-time %)))) chain)
|
||||
(reduce node/then-time {:at 0 :rate 1}
|
||||
(mapcat (fn [n] (cond-> [(node/time-of n)]
|
||||
(= :instance (:kind n)) (conj (node/source-time n))))
|
||||
chain)))}))
|
||||
|
||||
(defn slide
|
||||
"Move the node at row path `path` along its symbol's time by `df` frames of
|
||||
|
|
@ -343,7 +396,8 @@
|
|||
:let [n (get nodes (peek from))]]
|
||||
(or (node/placed-span n)
|
||||
(when (= :instance (:kind n))
|
||||
(node/placed-span (assoc n :span [0 (clip/frames clip (:of n))])))
|
||||
(node/placed-span
|
||||
(assoc n :span [0 (or (clip/frames clip (node/source n)) 0)])))
|
||||
whole))
|
||||
start (js/Math.floor (max 0 (apply min (map first spans))))
|
||||
end (min (second whole) (apply max (map second spans)))
|
||||
|
|
|
|||
|
|
@ -175,7 +175,7 @@
|
|||
move preserves and a timeline row draws with, and `local-frame` is what reads
|
||||
a frame, floors and the lead in their load-bearing order."
|
||||
[n]
|
||||
(let [{:keys [mode at rate offset] :or {at 0 rate 1 offset 0}} (:time n)]
|
||||
(let [{:keys [mode at rate offset] :or {mode :map at 0 rate 1 offset 0}} (:time n)]
|
||||
(if (= mode :map)
|
||||
{:at (- at (/ offset rate)) :rate rate}
|
||||
{:at 0 :rate 1})))
|
||||
|
|
@ -203,6 +203,53 @@
|
|||
(let [{:keys [at rate]} (time-of n)]
|
||||
[(+ at (/ in rate)) (+ at (/ out rate))])))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; what an instance places
|
||||
;;
|
||||
(defn source
|
||||
"The symbol used by this occurrence. Sequence groups arrange occurrences;
|
||||
a row is a view of that group, not one row per source."
|
||||
[n]
|
||||
(when (= :instance (:kind n)) (get-in n [:source :symbol])))
|
||||
|
||||
(defn sources
|
||||
"Structural references, including occurrences outside the playhead."
|
||||
[n]
|
||||
(if-let [sid (source n)] #{sid} #{}))
|
||||
|
||||
(defn playback-of [n]
|
||||
(merge {:in 0 :speed 1 :end :stop} (:playback n)))
|
||||
|
||||
(defn source-time
|
||||
"Invertible occurrence -> source map, or nil for holds and endpoint policies.
|
||||
Forward sampling remains available through `placed-frame` in every case."
|
||||
[n]
|
||||
(let [{:keys [in speed end]} (playback-of n)]
|
||||
(when (and (pos? speed) (= :stop end) (not (get-in n [:time :loop?])))
|
||||
{:at (- (/ in speed)) :rate speed})))
|
||||
|
||||
(defn placed-frame
|
||||
"Sample source time without changing the occurrence's property clock:
|
||||
`{:symbol :frame}`, the symbol shown and which of its frames. `length` is that
|
||||
symbol's frame count. Nil means no source contribution — this occurrence
|
||||
places nothing, or its playback has run past what there is to show."
|
||||
[n f length]
|
||||
(when-let [sid (source n)]
|
||||
(when (and (number? length) (pos? length))
|
||||
(let [{:keys [in speed end]} (playback-of n)
|
||||
raw (+ in (* speed f))
|
||||
frame (case (if (get-in n [:time :loop?]) :loop end)
|
||||
:loop (mod raw length)
|
||||
:hold (max 0 (min (dec length) raw))
|
||||
:stop raw)]
|
||||
(when (and (<= 0 frame) (< frame length))
|
||||
{:symbol sid :frame frame})))))
|
||||
|
||||
(defn sequence? [n]
|
||||
(and (= :group (:kind n)) (= :sequence (:layout n))))
|
||||
|
||||
(defn finite-number? [v] (and (number? v) (js/Number.isFinite v)))
|
||||
|
||||
(defn local-frame
|
||||
"Apply a node's time map to the frame it was handed by its parent.
|
||||
|
||||
|
|
@ -217,7 +264,7 @@
|
|||
as two performances; offset is PER-NODE by design, because mouth lead applies
|
||||
to performance nodes and not to the plate, which is the entire point of it."
|
||||
[n f]
|
||||
(let [{:keys [mode source-fps sample-fps] ex :expose :or {mode :inherit}} (:time n)]
|
||||
(let [{:keys [mode source-fps sample-fps] ex :expose :or {mode :map}} (:time n)]
|
||||
(if (= mode :inherit)
|
||||
f
|
||||
(do
|
||||
|
|
@ -370,15 +417,27 @@
|
|||
(not (contains? implemented-kinds k)))
|
||||
(conj (str ":kind " k " is in the vocabulary but not implemented"))
|
||||
|
||||
(and (= k :instance) (nil? (:of n))) (conj "an instance needs :of")
|
||||
(and (= k :instance) (not (keyword? (source n))))
|
||||
(conj "an instance needs :source {:symbol <symbol-id>}")
|
||||
(and (= k :instance)
|
||||
(let [{:keys [in speed end]} (playback-of n)]
|
||||
(not (and (finite-number? in) (<= 0 in)
|
||||
(finite-number? speed) (<= 0 speed)
|
||||
(#{:stop :hold :loop} end)))))
|
||||
(conj "playback needs a nonnegative finite :in and :speed, and :end :stop, :hold or :loop")
|
||||
(and (:layout n) (not (sequence? n)))
|
||||
(conj ":layout :sequence belongs to a group")
|
||||
(and (= k :audio) (not (some (:source n) [:footage :sound])))
|
||||
(conj "an audio node needs a :source :footage or :sound")
|
||||
(and (some? (get-in n [:time :rate]))
|
||||
(not (pos? (get-in n [:time :rate]))))
|
||||
(not (and (finite-number? (get-in n [:time :rate]))
|
||||
(pos? (get-in n [:time :rate])))))
|
||||
(conj ":time :rate must be positive")
|
||||
(nil? (:z n)) (conj "no :z — draw order is authored per scene, not implied by the tree")
|
||||
(and (:span n) (not= 2 (count (:span n))))
|
||||
(conj ":span must be [in out]")
|
||||
(and (:span n) (not (and (vector? (:span n)) (= 2 (count (:span n)))
|
||||
(every? finite-number? (:span n))
|
||||
(apply < (:span n)))))
|
||||
(conj ":span must be a finite, increasing [in out]")
|
||||
(some? (get-in n [:time :in]))
|
||||
(conj ":time has an :in — an instance's first frame is the start of its own :span"))
|
||||
|
||||
|
|
|
|||
|
|
@ -98,13 +98,22 @@
|
|||
at (fn [f p] (ch/value-at (get (node/channels n) p) f store))]
|
||||
(case (:kind n)
|
||||
:instance
|
||||
(let [sid (:of n)
|
||||
frames (clip/frames document sid)
|
||||
loop? (get-in n [:time :loop?])
|
||||
resolve (clip/resolver document sid store pal/index-of nil)]
|
||||
(fn [f]
|
||||
(let [f (if loop? (mod f frames) f)]
|
||||
(when (< -1 f frames)
|
||||
;; ONE RESOLVER PER DRAWING THE LANE CAN SHOW, built once for the reason
|
||||
;; the single one used to be: a resolver costs the symbol to build and a
|
||||
;; lookup to run, and a lane asked frame by frame through a fresh one is a
|
||||
;; resolver per frame.
|
||||
(let [loop? (get-in n [:time :loop?])
|
||||
resolvers (into {} (map (fn [child]
|
||||
[child (clip/resolver document child store
|
||||
pal/index-of nil)]))
|
||||
(node/sources n))]
|
||||
(fn [f0]
|
||||
(let [shown (node/placed-frame n f0 (clip/frames document (node/source n)))
|
||||
frames (when shown (clip/frames document (:symbol shown)))
|
||||
f (when (number? frames)
|
||||
(if loop? (mod (:frame shown) frames) (:frame shown)))
|
||||
resolve (when shown (get resolvers (:symbol shown)))]
|
||||
(when (and resolve (< -1 f frames))
|
||||
(reduce (fn [b {:keys [kind pts n cx cy r size]}]
|
||||
(case kind
|
||||
:poly (reduce #(grow %1 (aget pts (* 2 %2)) (aget pts (inc (* 2 %2))))
|
||||
|
|
|
|||
|
|
@ -2,7 +2,8 @@
|
|||
"An instance's explicit, held choices of source pose for each shape group.
|
||||
|
||||
A track is {local-frame -> source-frame}. The key is when the cut happens;
|
||||
the value is the frozen pose to read. Skipped source frames remain available.")
|
||||
the value is the frozen pose to read. Skipped source frames remain available."
|
||||
(:require [arthur.domain.node :as node]))
|
||||
|
||||
(defn prepare
|
||||
"Sort exposure tracks once when building a resolver."
|
||||
|
|
@ -35,14 +36,17 @@
|
|||
"Set one held pose on an instance inside symbol `sid`. Earlier motion stays
|
||||
untouched."
|
||||
[clip sid instance group at source]
|
||||
(let [node (get-in clip [:symbols sid :nodes instance])
|
||||
placed (get-in clip [:symbols (:of node)])
|
||||
length (:frames placed)
|
||||
(let [inst (get-in clip [:symbols sid :nodes instance])
|
||||
;; A cut is checked against the ONE symbol this occurrence places. Which
|
||||
;; drawing a lane shows is a question about the lane's other occurrences,
|
||||
;; and each of them owns its own tracks — so there is nothing to union.
|
||||
placed (get-in clip [:symbols (node/source inst)])
|
||||
length (or (:frames placed) 0)
|
||||
active (filter (fn [n] (some :pose-sampled? (vals (:channels n))))
|
||||
(vals (:nodes placed)))
|
||||
groups (set (map #(or (:pose-group %) (:id %)) active))
|
||||
ids (set (map :id active))]
|
||||
(when-not (and (= :instance (:kind node))
|
||||
(when-not (and (= :instance (:kind inst))
|
||||
(or (contains? groups group)
|
||||
(and (vector? group) (= 2 (count group))
|
||||
(= :node (first group))
|
||||
|
|
|
|||
|
|
@ -30,10 +30,9 @@
|
|||
[arthur.domain.wire :as wire]))
|
||||
|
||||
(def schema-version
|
||||
"The stored document format this client reads and writes. 2 is symbols: leaf
|
||||
paths say `symbol`, a placing node is `:kind :instance`, and no symbol id is
|
||||
reserved. `clips/migrations/0007` moved every saved project from 1."
|
||||
2)
|
||||
"3 stores occurrence source references and explicit playback clocks. Older
|
||||
source-channel documents are unsupported; there is no compatibility conversion."
|
||||
3)
|
||||
|
||||
(defn block-keys
|
||||
"Every tier-2 key a leaf map names, in a stable order."
|
||||
|
|
|
|||
122
frontend/src/arthur/domain/sequence.cljs
Normal file
122
frontend/src/arthur/domain/sequence.cljs
Normal file
|
|
@ -0,0 +1,122 @@
|
|||
(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]))
|
||||
|
||||
(defn members [nodes lane]
|
||||
(->> (vals nodes)
|
||||
(filter #(= lane (:parent %)))
|
||||
(sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %))))
|
||||
vec))
|
||||
|
||||
(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)))
|
||||
|
||||
(defn- lane-map
|
||||
"Lane -> containing symbol, as an invertible map in the opposite direction.
|
||||
Refuse floors and loops rather than pretend an affine map preserves them."
|
||||
[nodes id]
|
||||
(loop [id id seen #{} chain []]
|
||||
(if (nil? id)
|
||||
(reduce node/then-time {:at 0 :rate 1} (map node/time-of (reverse chain)))
|
||||
(let [n (get nodes id) t (:time n)]
|
||||
(when (and n (not (contains? seen id))
|
||||
(not (:loop? t)) (not (:sample-fps t))
|
||||
(<= (or (:expose t) 1) 1))
|
||||
(recur (:parent n) (conj seen id) (conj chain n)))))))
|
||||
|
||||
(defn- finish
|
||||
[clip sid nodes selection extent]
|
||||
(let [sym (get-in clip [:symbols sid])
|
||||
changed (for [[id n] nodes :when (node/sequence? n)
|
||||
child (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)]
|
||||
(cond
|
||||
(seq ps) {:refused (first ps)}
|
||||
(not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"}
|
||||
(and (> end (:frames sym)) (= :keep extent))
|
||||
{:refused (str "the edit needs " (js/Math.ceil end) " frames; extend the shot to continue")
|
||||
:required-frames (js/Math.ceil end)}
|
||||
:else {:clip (-> clip
|
||||
(assoc-in [:symbols sid :nodes] nodes)
|
||||
(assoc-in [:symbols sid :frames] (js/Math.ceil end)))
|
||||
:selection selection})))
|
||||
|
||||
(defn extend-hold
|
||||
"Change one held occurrence's duration by `delta` lane frames and ripple its
|
||||
later siblings. Lane channels, occurrence channels and source clocks stay put.
|
||||
Returns {:clip :selection} or {:refused :required-frames?}; never partially edits."
|
||||
[clip sid id delta {:keys [extent] :or {extent :keep}}]
|
||||
(let [nodes (get-in clip [:symbols sid :nodes])
|
||||
n (get nodes id)
|
||||
lane (get nodes (:parent n))
|
||||
rate (:rate (node/time-of n))
|
||||
span (:span n)
|
||||
m (when lane (lane-map nodes (:id lane)))]
|
||||
(cond
|
||||
(not (node/sequence? lane)) {:refused "select an occurrence in a sequence lane"}
|
||||
(seq (problems nodes)) {:refused (first (problems nodes))}
|
||||
(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"}
|
||||
(<= (+ (second span) (* rate delta)) (first span)) {:refused "a drawing must keep a positive exposure"}
|
||||
:else
|
||||
(let [[_ boundary] (node/placed-span n)
|
||||
later (filter #(>= (first (node/placed-span %)) boundary)
|
||||
(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))
|
||||
nodes later)]
|
||||
(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]))
|
||||
{: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}}]
|
||||
(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))))))))))
|
||||
|
|
@ -55,6 +55,7 @@
|
|||
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]))
|
||||
|
|
@ -516,9 +517,10 @@
|
|||
;; placed but emit no op, and which are exactly what an underlay rides.
|
||||
placed (volatile! {})
|
||||
ctx {:read (fn [id path c lf]
|
||||
(ch/sample! (get-in cursors [id path])
|
||||
(channel-frame choices traces nodes
|
||||
source-fps picture-fps id c lf)))
|
||||
(when-let [cursor (get-in cursors [id path])]
|
||||
(ch/sample! cursor
|
||||
(channel-frame choices traces nodes
|
||||
source-fps picture-fps id c lf))))
|
||||
:palette palette
|
||||
:mat-for (fn [id] (get mats id))
|
||||
:on-place (fn [id p] (vswap! placed assoc id p))
|
||||
|
|
@ -571,6 +573,7 @@
|
|||
(if-not (map? nodes)
|
||||
[":nodes must be a map of id -> node"]
|
||||
(-> []
|
||||
(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)))))
|
||||
|
|
|
|||
|
|
@ -114,9 +114,15 @@
|
|||
(letfn [(walk [sid path]
|
||||
(mapcat (fn [[id n]]
|
||||
(when (= :instance (:kind n))
|
||||
;; Every drawing the lane can show, not only the one it
|
||||
;; happens to be on: a face traced in one cel is the same
|
||||
;; face when the lane cuts to another.
|
||||
(let [p (conj path id)]
|
||||
(cond->> (walk (:of n) p)
|
||||
(traceable? clip (:of n)) (cons {:path p :in sid :face (:of n)})))))
|
||||
(mapcat (fn [child]
|
||||
(cond->> (walk child p)
|
||||
(traceable? clip child)
|
||||
(cons {:path p :in sid :face child})))
|
||||
(sort-by str (node/sources n))))))
|
||||
(sort-by (comp str key) (get-in clip [:symbols sid :nodes]))))]
|
||||
(vec (walk sid []))))
|
||||
|
||||
|
|
|
|||
|
|
@ -73,3 +73,11 @@
|
|||
"Apply `f` to the loaded clip and return the new db."
|
||||
[db f]
|
||||
(edit-entry db #(update % :clip f)))
|
||||
|
||||
(defn transaction
|
||||
"One command is one undo step, independent of neighboring edits or timing."
|
||||
[db f]
|
||||
(-> db
|
||||
(history history/hold)
|
||||
(edit f)
|
||||
(history history/settle)))
|
||||
|
|
|
|||
|
|
@ -8,8 +8,11 @@
|
|||
(:require [arthur.domain.clip :as clip]
|
||||
[arthur.domain.gesture :as gesture]
|
||||
[arthur.domain.nest :as nest]
|
||||
[arthur.domain.node :as node]
|
||||
[arthur.domain.sequence :as sequence]
|
||||
[arthur.events.edit :as edit]
|
||||
[arthur.events.paint :as paint]
|
||||
[arthur.events.playback :as playback]
|
||||
[arthur.footage.store :as store]
|
||||
[re-frame.core :as rf]))
|
||||
|
||||
|
|
@ -24,7 +27,7 @@
|
|||
[:clip :symbols sid :nodes id :kind]))]
|
||||
(cond-> (-> db
|
||||
(assoc-in [:ui :selection] selection)
|
||||
(update :ui dissoc :points))
|
||||
(update :ui dissoc :points :sequence-retry))
|
||||
(and (= :node kind) path (not sound?))
|
||||
(update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))))
|
||||
|
||||
|
|
@ -32,6 +35,60 @@
|
|||
::set-tone
|
||||
(fn [db [_ tone]] (assoc-in db [:ui :tone] tone)))
|
||||
|
||||
(defn apply-sequence-command
|
||||
"Commit a successful domain command as one history step. A refused command
|
||||
leaves the document and history untouched; an overflow offers an explicit retry."
|
||||
[db sid result retry]
|
||||
(if-let [why (:refused result)]
|
||||
(-> db
|
||||
(assoc-in [:project :status] why)
|
||||
(assoc-in [:ui :sequence-retry]
|
||||
(when (:required-frames result) retry)))
|
||||
(let [[_ selected-sid _ path] (get-in db [:ui :selection])
|
||||
prefix (if (and (= sid selected-sid) (seq path)) (pop path) [])]
|
||||
(-> db
|
||||
(edit/transaction (constantly (:clip result)))
|
||||
(assoc-in [:ui :selection] [:node sid (:selection result) (conj prefix (:selection result))])
|
||||
(update :ui dissoc :sequence-retry)))))
|
||||
|
||||
(rf/reg-event-db
|
||||
::new-lane
|
||||
(fn [db _]
|
||||
(let [clip (:clip (store/entry (:clip/current db)))
|
||||
sid (get-in db [:ui :open])]
|
||||
(apply-sequence-command db sid (sequence/add-lane clip sid (random-uuid)) nil))))
|
||||
|
||||
(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))])))))
|
||||
|
||||
(rf/reg-event-db
|
||||
::extend-hold
|
||||
(fn [db [_ delta extent]]
|
||||
(let [clip (:clip (store/entry (:clip/current db)))
|
||||
[_ sid id] (get-in db [:ui :selection])
|
||||
result (sequence/extend-hold clip sid id delta {:extent (or extent :keep)})]
|
||||
(apply-sequence-command db sid result [::extend-hold delta :grow-symbol]))))
|
||||
|
||||
(rf/reg-event-fx
|
||||
::sequence-retry
|
||||
(fn [{:keys [db]} _]
|
||||
(if-let [event (get-in db [:ui :sequence-retry])]
|
||||
{:db (update db :ui dissoc :sequence-retry) :dispatch event}
|
||||
{})))
|
||||
|
||||
(rf/reg-event-db
|
||||
::toggle-row
|
||||
(fn [db [_ path]]
|
||||
|
|
|
|||
|
|
@ -751,8 +751,9 @@
|
|||
:channels (face-placement params subjects)}}
|
||||
(map-indexed
|
||||
(fn [i [id _]]
|
||||
[id {:id id :kind :instance :of id :parent :face
|
||||
:z (str "a" i)}]))
|
||||
[id {:id id :kind :instance :parent :face
|
||||
:z (str "a" i)
|
||||
:source {:symbol id}}]))
|
||||
ordered)}}
|
||||
(map (fn [[id part]] [id (:symbol part)])) parts)}]
|
||||
(doseq [[subject inputs] ordered
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
(:require [arthur.domain.clip :as clip]
|
||||
[arthur.domain.gesture :as gesture]
|
||||
[arthur.domain.nest :as nest]
|
||||
[arthur.domain.node :as node]
|
||||
[arthur.domain.palette :as pal]
|
||||
[arthur.domain.symbol :as symbol]
|
||||
[arthur.domain.trace :as trace]
|
||||
|
|
@ -114,7 +115,11 @@
|
|||
(defn- placed?
|
||||
"Does row `path` from symbol `sid` still name an instance, all the way down?"
|
||||
[clip sid path]
|
||||
(reduce (fn [sid id] (or (get-in clip [:symbols sid :nodes id :of]) (reduced nil)))
|
||||
;; Only an occurrence names a symbol. A lane is a group, so a row path that
|
||||
;; ends at the lane rather than at one of its cels names no placement — which
|
||||
;; is the structural answer, and does not move as the lane cuts.
|
||||
(reduce (fn [sid id]
|
||||
(or (node/source (get-in clip [:symbols sid :nodes id])) (reduced nil)))
|
||||
sid path))
|
||||
|
||||
(rf/reg-sub
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
[re-frame.core :as rf]))
|
||||
|
||||
(rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection])))
|
||||
(rf/reg-sub ::sequence-retry (fn [db _] (get-in db [:ui :sequence-retry])))
|
||||
(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 ::draft (fn [db _] (get-in db [:ui :draft])))
|
||||
|
|
|
|||
|
|
@ -215,9 +215,9 @@
|
|||
[facts
|
||||
"name" (or (:name n) (brief id))
|
||||
"id" (brief id)
|
||||
;; Which symbol an instance places. The one fact that makes an instance
|
||||
;; Which symbol an occurrence places. The one fact that makes an instance
|
||||
;; legible as an instance rather than as a node.
|
||||
"of" (when (= :instance (:kind n)) (str (:of n)))
|
||||
"of" (when (= :instance (:kind n)) (str (node/source n)))
|
||||
;; A span is in the node's OWN frames and `at` is where its frame 0 sits
|
||||
;; in this symbol. See `node/placed-span`.
|
||||
"span" (when start (str start " … " end))
|
||||
|
|
@ -439,7 +439,10 @@
|
|||
;; symbol — which is the face itself when a face is open to be drawn over.
|
||||
;; That last case had no section at all before, and it is the one where
|
||||
;; the keys are actually being set.
|
||||
placed (:of (peek node))
|
||||
;; The symbol this occurrence places, or nil for a lane: which face a
|
||||
;; lane traces is not a question with one answer, and naming the drawing
|
||||
;; showing now would move the section under the playhead.
|
||||
placed (node/source (peek node))
|
||||
face (or placed (when (trace/traceable? clip open) open))
|
||||
faces (when face (trace/faces clip face))
|
||||
;; Where that face sits, as a row path from the open symbol, so the faces
|
||||
|
|
|
|||
|
|
@ -22,6 +22,9 @@
|
|||
happen and not where they happen again."
|
||||
(: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]
|
||||
[arthur.events.ui :as ui]
|
||||
|
|
@ -52,10 +55,16 @@
|
|||
(let [{:keys [at rate]} (node/time-of n)]
|
||||
(if (and (zero? at) (= 1 rate))
|
||||
identity
|
||||
(fn [f] (js/Math.round (+ at (/ f rate)))))))
|
||||
(fn [f] (+ at (/ f rate))))))
|
||||
|
||||
(defn- keyed-frames [ch] (some-> (:keys ch) keys sort))
|
||||
|
||||
(defn- source-frames
|
||||
"How long the thing this node places is, for a placement carrying no span of
|
||||
its own. 0 for a node that places nothing, or a reference with nothing there."
|
||||
[clip n]
|
||||
(or (get-in clip [:symbols (node/source n) :frames]) 0))
|
||||
|
||||
(defn- node-label
|
||||
"What to call a node in the label column.
|
||||
|
||||
|
|
@ -105,19 +114,23 @@
|
|||
;; symbol is resolved in — `clip/resolver` roots the
|
||||
;; child at this node's local frame — so the nested
|
||||
;; walk carries it down unchanged.
|
||||
self (comp ->open (local->parent n))
|
||||
span (mapv ->open
|
||||
ancestors (rest (symbol/lineage (:nodes sym) id))
|
||||
parent-map (reduce comp ->open
|
||||
(map #(local->parent (get-in sym [:nodes %]))
|
||||
(reverse ancestors)))
|
||||
self (comp parent-map (local->parent n))
|
||||
span (mapv parent-map
|
||||
(or (node/placed-span
|
||||
(cond-> n
|
||||
(and (= :instance (:kind n)) (nil? (:span n)))
|
||||
(assoc :span [0 (get-in clip [:symbols (:of n) :frames])])))
|
||||
(assoc :span [0 (source-frames clip n)])))
|
||||
[0 (:frames sym)]))
|
||||
row {:path rpath
|
||||
:depth depth
|
||||
:label (node-label id n)
|
||||
:kind :node
|
||||
:node-kind (:kind n)
|
||||
:of (:of n)
|
||||
:of (node/source n)
|
||||
:select [:node sid id rpath]
|
||||
:expandable? true
|
||||
:expanded? open?
|
||||
|
|
@ -127,60 +140,65 @@
|
|||
(distinct))
|
||||
(vals channels))
|
||||
:dense? (boolean (some :dense (vals channels)))}]
|
||||
(if-not open?
|
||||
[row]
|
||||
(-> [row]
|
||||
(into (channel-rows n rpath (inc depth) self span))
|
||||
(into (when (= :instance (:kind n))
|
||||
(walk (:of n) rpath (inc depth) self)))))))
|
||||
;; AN OCCURRENCE IS NOT A ROW. A lane's drawings are cel
|
||||
;; blocks on the lane's own row, so a lane of twelve
|
||||
;; exposures is one row and not twelve — which is the
|
||||
;; vertical growth that made a keyed source look
|
||||
;; necessary. The occurrence is still the thing selected
|
||||
;; and addressed; only its presentation is shared.
|
||||
(if (node/sequence? (get-in sym [:nodes (:parent n)]))
|
||||
[]
|
||||
(let [row (cond-> row
|
||||
(node/sequence? n)
|
||||
(assoc :cels
|
||||
(mapv (fn [child]
|
||||
{:id (:id child)
|
||||
:label (or (get-in clip [:symbols (node/source child) :name])
|
||||
(some-> (node/source child) name))
|
||||
: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))))]
|
||||
(if-not open?
|
||||
[row]
|
||||
(-> [row]
|
||||
(into (channel-rows n rpath (inc depth) self span))
|
||||
(into (when-let [{:keys [at rate]} (and (= :instance (:kind n))
|
||||
(node/source-time n))]
|
||||
(when-let [child (node/source n)]
|
||||
(walk child rpath (inc depth)
|
||||
(comp self #(+ at (/ % rate)))))))))))))
|
||||
ordered))))]
|
||||
(if (get-in clip [:symbols sid])
|
||||
(walk sid [] 0 identity)
|
||||
[])))
|
||||
|
||||
(defn sound-rows
|
||||
"Every sound symbol `sid` plays, one row each, below the picture as an
|
||||
editor's audio tracks are: its own, and those inside what it places at any
|
||||
depth — each TIED to the placement it is heard through, `:via`, and drawn
|
||||
where it is heard, cut to that placement's span as the mix cuts it."
|
||||
"Audio rows use the same flattened intervals as the mixer, including source
|
||||
in-points, occurrence speeds, parent timing, and silence beneath visual holds."
|
||||
[clip sid expanded]
|
||||
(letfn [(walk [sid path ->open [lo hi] via]
|
||||
(mapcat
|
||||
(fn [[id n]]
|
||||
(let [rpath (conj path id)
|
||||
self (comp ->open (local->parent n))
|
||||
[a b] (mapv ->open (or (node/placed-span
|
||||
(cond-> n
|
||||
(and (= :instance (:kind n)) (nil? (:span n)))
|
||||
(assoc :span [0 (get-in clip [:symbols (:of n) :frames])])))
|
||||
[0 (get-in clip [:symbols sid :frames])]))
|
||||
span [(max lo a) (min hi b)]
|
||||
open? (contains? expanded rpath)]
|
||||
(case (:kind n)
|
||||
:audio (cons {:path rpath
|
||||
:depth 0
|
||||
:label (node-label id n)
|
||||
:kind :node
|
||||
:node-kind :audio
|
||||
:via via
|
||||
;; A sound heard through a placement is
|
||||
;; that placement's picture's sound: its bar
|
||||
;; moves the placement, so the two stay in
|
||||
;; sync. Moving the placement moves it too.
|
||||
:slides (if via (subvec rpath 0 1) rpath)
|
||||
:select [:node sid id rpath]
|
||||
:expandable? true
|
||||
:expanded? open?
|
||||
:span span
|
||||
:keys (into [] (comp (mapcat keyed-frames) (map self) (distinct))
|
||||
(vals (node/channels n)))}
|
||||
(when open? (channel-rows n rpath 1 self span)))
|
||||
:instance (walk (:of n) rpath self span (or via (node-label id n)))
|
||||
nil)))
|
||||
(sort-by (fn [[id n]] [(or (:z n) "") (str id)]) (get-in clip [:symbols sid :nodes]))))]
|
||||
(if (get-in clip [:symbols sid])
|
||||
(vec (walk sid [] identity [##-Inf ##Inf] nil))
|
||||
[])))
|
||||
(if-not (get-in clip [:symbols sid]) []
|
||||
(vec
|
||||
(mapcat
|
||||
(fn [[path tracks]]
|
||||
(let [n (first tracks)
|
||||
span (node/placed-span n)
|
||||
select [:node (:owner n) (:id n) path]
|
||||
open? (contains? expanded path)
|
||||
via (when (< 1 (count path)) (str (first path)))
|
||||
row {:path path :depth 0 :label (node-label (:id n) n)
|
||||
:kind :node :node-kind :audio :via via
|
||||
:slides (if via (subvec path 0 1) path)
|
||||
:select select :expandable? true :expanded? open? :span span
|
||||
:keys (vec (distinct (mapcat keyed-frames (vals (:channels n)))))}]
|
||||
(cons (cond-> row
|
||||
(< 1 (count tracks))
|
||||
(assoc :cels (mapv (fn [i track]
|
||||
{:id i :label (node-label (:id track) track)
|
||||
:span (node/placed-span track) :select select})
|
||||
(range) tracks)))
|
||||
(when open? (channel-rows n path 1 identity span)))))
|
||||
(sort-by (comp str key) (group-by :path (nest/audio-tracks clip sid)))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; geometry
|
||||
|
|
@ -206,7 +224,13 @@
|
|||
rate @(rf/subscribe [::playback/rate])
|
||||
frame @(rf/subscribe [::playback/frame])
|
||||
frames @(rf/subscribe [::render/frames])
|
||||
{:keys [fps drop]} @player/meter]
|
||||
{:keys [fps drop]} @player/meter
|
||||
clip @(rf/subscribe [::render/clip])
|
||||
[_ sid id] @(rf/subscribe [::sub/selection])
|
||||
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))))]
|
||||
[:div.pane-head
|
||||
[:button {:on-click #(rf/dispatch [::pb/toggle])} (if playing? "pause" "play")]
|
||||
[:button {:on-click #(rf/dispatch [::pb/seek 0])} "|<"]
|
||||
|
|
@ -228,6 +252,18 @@
|
|||
[:button {:title "a new empty symbol inside the selected instance, or beside the selected node, or in the open symbol"
|
||||
:on-click #(rf/dispatch [::ui/new-symbol])}
|
||||
"+ symbol"]
|
||||
[:button {:on-click #(rf/dispatch [::ui/new-lane])} "+ lane"]
|
||||
[: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 held?)
|
||||
:title "shorten this exposure; ripple later drawings, keeping lane keys fixed"
|
||||
:on-click #(rf/dispatch [::ui/extend-hold -1])} "hold −"]
|
||||
[:button {:disabled (not held?)
|
||||
:title "extend this exposure; ripple later drawings, keeping lane keys fixed"
|
||||
:on-click #(rf/dispatch [::ui/extend-hold 1])} "hold +"]
|
||||
(when @(rf/subscribe [::sub/sequence-retry])
|
||||
[:button {:on-click #(rf/dispatch [::ui/sequence-retry])} "extend shot and apply"])
|
||||
[:span.spacer]
|
||||
[:span.dim (str frame " / " frames)]
|
||||
;; Measured in the loop, not derived from the clock — the whole question
|
||||
|
|
@ -353,7 +389,7 @@
|
|||
"`sliding` is the pointer's side of a bar being dragged, `{:path :x :width
|
||||
:df}`. What it looks like mid-drag is `[:ui :sliding]`, which the clip every
|
||||
row and the stage are drawn from already has in it."
|
||||
[{:keys [path span keys dense? kind node-kind select slides]} frames sliding]
|
||||
[{:keys [path span keys dense? kind node-kind select slides cels]} frames sliding]
|
||||
(let [{from :path x0 :x width :width} @sliding
|
||||
slide (fn [^js e]
|
||||
(when (= path from)
|
||||
|
|
@ -374,7 +410,7 @@
|
|||
:on-pointer-cancel (fn [_] (done false))}
|
||||
;; Clipped to the ruler: an instance longer than the room left in its
|
||||
;; symbol still plays its own frames from 0, it is just cut off at the end.
|
||||
(when-let [[in out] (when span [(max 0 (first span)) (min frames (second span))])]
|
||||
(when-let [[in out] (when (and span (nil? cels)) [(max 0 (first span)) (min frames (second span))])]
|
||||
(when (< in out)
|
||||
[:div {:class (str "tl-span" (when dense? " dense") (when (= :ghost kind) " ghost")
|
||||
(when (= :audio node-kind) " sound")
|
||||
|
|
@ -393,6 +429,22 @@
|
|||
;; the browser has no record of.
|
||||
(try (.setPointerCapture track (.-pointerId e))
|
||||
(catch :default _ nil)))))}]))
|
||||
(doall
|
||||
(for [{:keys [id label source span select]} cels
|
||||
:let [in (max 0 (first span)) out (min frames (second span))]
|
||||
:when (< in out)]
|
||||
^{:key (str id)}
|
||||
[:button.tl-cel
|
||||
{:title (str label " · select occurrence; double-click to edit shared drawing")
|
||||
:style {:position "absolute" :left (edge% in frames)
|
||||
:width (str (* 100 (/ (- out in) (max 1 frames))) "%")
|
||||
:top "2px" :bottom "2px" :overflow "hidden" :padding "0 3px"}
|
||||
:on-click (fn [e] (.stopPropagation e)
|
||||
(rf/dispatch [::ui/select select])
|
||||
(rf/dispatch [::pb/seek (js/Math.floor in)]))
|
||||
:on-double-click (fn [e] (.stopPropagation e)
|
||||
(when source (rf/dispatch [::pb/open-symbol source])))}
|
||||
label]))
|
||||
;; A dense channel has a value on every frame, so ticking each one is a solid
|
||||
;; block that says less than the bar behind it already does.
|
||||
(when-not dense?
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
(ns arthur.domain.bring-test
|
||||
(:require [cljs.test :refer [deftest is]]
|
||||
[arthur.domain.bring :as bring]
|
||||
[arthur.domain.clip :as clip]))
|
||||
[arthur.domain.clip :as clip]
|
||||
[arthur.domain.node :as node]))
|
||||
|
||||
(defn- nested
|
||||
"Three symbols: :outer places :inner, and :loose is placed by nothing."
|
||||
|
|
@ -21,6 +22,6 @@
|
|||
(is (= {:main :take :inner :inner-2} ids)
|
||||
"the root gets the name asked for; a taken id gets the next free one")
|
||||
(is (= 10 (clip/frames clip :inner)) "what was already here is untouched")
|
||||
(is (= :inner-2 (:of (first (vals (get-in clip [:symbols :take :nodes])))))
|
||||
(is (= #{:inner-2} (node/sources (first (vals (get-in clip [:symbols :take :nodes])))))
|
||||
"and the copy's instance follows its renamed symbol")
|
||||
(is (empty? (clip/problems clip)))))
|
||||
|
|
|
|||
|
|
@ -27,12 +27,14 @@
|
|||
(assoc-in [:symbols :main]
|
||||
{:id :main :frames 6
|
||||
:nodes {:root {:id :root :kind :group :z "a1"}
|
||||
:left {:id :left :kind :instance :of :sym/test
|
||||
:left {:id :left :kind :instance
|
||||
:parent :root :z "a1" :span [0 4]
|
||||
:source {:symbol :sym/test}
|
||||
:channels {[:xform :pos] (ch/framed [100 50])}}
|
||||
:right {:id :right :kind :instance :of :sym/test
|
||||
:right {:id :right :kind :instance
|
||||
:parent :root :z "a2" :span [0 4]
|
||||
:time {:mode :map :at 2 :rate 1}
|
||||
:source {:symbol :sym/test}
|
||||
:channels {[:xform :pos] (ch/framed [120 50])}}}})
|
||||
(assoc-in [:symbols :sym/test]
|
||||
(assoc (get-in source [:symbols :main]) :id :sym/test)))
|
||||
|
|
@ -66,13 +68,15 @@
|
|||
:symbols
|
||||
{:main {:id :main :frames 30
|
||||
:nodes {:root {:id :root :kind :group :z "a1"}
|
||||
:first {:id :first :kind :instance :of :sym/poses
|
||||
:first {:id :first :kind :instance
|
||||
:parent :root :z "a1"
|
||||
:source {:symbol :sym/poses}
|
||||
:playback {:tracks {:mouth {0 0, 8 20, 9 21}
|
||||
[:node :mouth-detail] {0 0, 8 4}
|
||||
:eye {0 0, 4 4}}}}
|
||||
:second {:id :second :kind :instance :of :sym/poses
|
||||
:second {:id :second :kind :instance
|
||||
:parent :root :z "a2"
|
||||
:source {:symbol :sym/poses}
|
||||
:playback {:tracks {:mouth {0 0, 8 8}}}}}}
|
||||
:sym/poses symbol}}
|
||||
store {"sizes" {:data values}}
|
||||
|
|
@ -109,8 +113,9 @@
|
|||
(deftest stage-pose-edits-preserve-earlier-motion-and-survive-save
|
||||
(let [document (-> source
|
||||
(assoc-in [:symbols :main :nodes :placed]
|
||||
{:id :placed :kind :instance :of :sym/test :parent :root
|
||||
:z "a2"})
|
||||
{:id :placed :kind :instance :parent :root
|
||||
:z "a2"
|
||||
:source {:symbol :sym/test}})
|
||||
(assoc-in [:symbols :sym/test]
|
||||
{:id :sym/test :frames 4
|
||||
:nodes {:root {:id :root :kind :group :z "a1"}
|
||||
|
|
@ -153,8 +158,8 @@
|
|||
(let [document (stage/compose source)]
|
||||
(is (empty? (clip/problems document)))
|
||||
(is (= #{:main :sym/face-8625} (set (keys (:symbols document)))))
|
||||
(is (= :sym/face-8625 (:of (placement document :left))))
|
||||
(is (= :sym/face-8625 (:of (placement document :right))))
|
||||
(is (= #{:sym/face-8625} (node/sources (placement document :left))))
|
||||
(is (= #{:sym/face-8625} (node/sources (placement document :right))))
|
||||
(testing "every placement is keyed by its own uuid"
|
||||
;; The identity change: seven placements of one drawing are seven things,
|
||||
;; and each is named by something that means only itself. Sharing a key, or
|
||||
|
|
@ -165,7 +170,7 @@
|
|||
(is (every? uuid? (map key symbols)))
|
||||
(is (= 7 (count (distinct (map key symbols)))))
|
||||
(testing "and each still says which drawing it plays and what to call it"
|
||||
(is (every? #(= :sym/face-8625 (:of (val %))) symbols))
|
||||
(is (every? #(= #{:sym/face-8625} (node/sources (val %))) symbols))
|
||||
(is (every? #(string? (:name (val %))) symbols))
|
||||
(is (= 7 (count (distinct (map #(:name (val %)) symbols))))))))
|
||||
(is (= 7 (count (filter #(= :instance (:kind %))
|
||||
|
|
@ -221,7 +226,7 @@
|
|||
(is (= :main (clip/opens-on (clip/blank)))))
|
||||
(testing "an instance can go into any symbol, and spans that symbol's frames"
|
||||
(let [[n] (vals (get-in c [:symbols :outer :nodes]))]
|
||||
(is (= :inner (:of n)))
|
||||
(is (= #{:inner} (node/sources n)))
|
||||
(is (= [0 10] (:span n)) "its own frames: all of what it places, from its own 0")
|
||||
(is (= [5 15] (node/placed-span n)) "and where that lands in the symbol it is in")))
|
||||
(testing "placing is refused when it would make a cycle"
|
||||
|
|
@ -246,14 +251,17 @@
|
|||
(is (= {:id :symbol-1 :name "symbol-1" :frames 180 :nodes {}}
|
||||
(clip/symbol made :symbol-1))
|
||||
"empty, and as long as the rest of what it was placed in")
|
||||
(is (= {:of :symbol-1 :span [0 180] :time {:mode :map :at 20 :rate 1}}
|
||||
(select-keys (get-in made [:symbols :outer :nodes u]) [:of :span :time])))
|
||||
(is (= {:span [0 180] :time {:mode :map :at 20 :rate 1}}
|
||||
(select-keys (get-in made [:symbols :outer :nodes u]) [:span :time])))
|
||||
(is (= #{:symbol-1} (node/sources (get-in made [:symbols :outer :nodes u])))
|
||||
"and it places the symbol it just made")
|
||||
(is (empty? (clip/problems made)))
|
||||
(is (= c (clip/new-symbol c :outer :inner 0 u)) "an id already in use is refused")
|
||||
(is (= c (clip/new-symbol c :outer id 200 u)) "past the end is refused")))
|
||||
|
||||
(deftest an-instance-span-is-in-its-own-frames
|
||||
(let [n {:id :i :kind :instance :of :x :z "a1" :span [3 13]
|
||||
(let [n {:id :i :kind :instance :z "a1" :span [3 13]
|
||||
:source {:symbol :x}
|
||||
:time {:mode :map :at 40 :rate 2}}]
|
||||
(is (= [41.5 46.5] (node/placed-span n)) "own frames 3 to 13, at double rate, from 40")
|
||||
(is (= 0 (node/local-frame n 40)) "the parent's :at is where its own frame 0 lands")
|
||||
|
|
|
|||
238
frontend/test/arthur/domain/lane_test.cljs
Normal file
238
frontend/test/arthur/domain/lane_test.cljs
Normal file
|
|
@ -0,0 +1,238 @@
|
|||
(ns arthur.domain.lane-test
|
||||
(:require [cljs.test :refer [deftest is testing]]
|
||||
[arthur.domain.bring :as bring]
|
||||
[arthur.domain.channel :as ch]
|
||||
[arthur.domain.clip :as clip]
|
||||
[arthur.domain.history :as history]
|
||||
[arthur.domain.leaf :as leaf]
|
||||
[arthur.domain.nest :as nest]
|
||||
[arthur.domain.node :as node]
|
||||
[arthur.domain.palette :as pal]
|
||||
[arthur.domain.pick :as pick]
|
||||
[arthur.domain.sequence :as sequence]
|
||||
[arthur.domain.symbol :as symbol]))
|
||||
|
||||
(defn drawing [id x frames]
|
||||
{:id id :frames frames
|
||||
:nodes {:mark {:id :mark :kind :rect :z "a"
|
||||
:channels {[:geom :size] (ch/framed 4)
|
||||
[:xform :pos] (ch/framed [x 0])}}}})
|
||||
|
||||
(defn occurrence [id source at duration speed]
|
||||
{:id id :kind :instance :parent :girl :z (name id)
|
||||
:source {:symbol source} :playback {:in 0 :speed speed :end :stop}
|
||||
:time {:at at :rate 1} :span [0 duration]})
|
||||
|
||||
(defn document []
|
||||
(let [a (occurrence :a :drawing-a 0 4 0)
|
||||
b (assoc-in (occurrence :b :drawing-b 4 4 0)
|
||||
[:channels [:xform :pos]] (ch/keyed {0 [0 0] 1 [2 0]} :hold))
|
||||
insert (assoc-in (occurrence :insert :wave 8 4 1) [:playback :in] 3)]
|
||||
{:name "exposures" :fps 24 :width 320 :height 200
|
||||
:symbols
|
||||
{:main {:id :main :frames 12
|
||||
:nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"
|
||||
:channels {[:xform :pos] (ch/keyed {0 [0 0] 6 [60 0] 12 [0 0]} :linear)}}
|
||||
:a a :b b :insert insert
|
||||
:plate {:id :plate :kind :rect :z "a"
|
||||
:channels {[:geom :size] (ch/framed 10)
|
||||
[:xform :pos] (ch/keyed {0 [-40 0] 11 [70 0]} :linear)}}}}
|
||||
:drawing-a (drawing :drawing-a 10 1)
|
||||
:drawing-b (drawing :drawing-b 20 1)
|
||||
:wave (assoc-in (drawing :wave 0 10) [:nodes :mark :channels [:xform :pos]]
|
||||
(ch/keyed {0 [0 0] 9 [900 0]} :linear))}}))
|
||||
|
||||
(defn sample [doc fs]
|
||||
(let [r (clip/resolver doc :main nil pal/index-of nil)]
|
||||
(into {} (map (fn [f] [f (into {} (map (juxt :node :cx)) (r f))])) fs)))
|
||||
|
||||
(deftest one-lane-mixes-held-drawings-and-playing-content
|
||||
(let [doc (document) at (sample doc (range 12))]
|
||||
(is (empty? (clip/problems doc)))
|
||||
(is (= 40 (get-in at [3 [:a :mark]])))
|
||||
(is (= 60 (get-in at [4 [:b :mark]])))
|
||||
(is (= 72 (get-in at [5 [:b :mark]])))
|
||||
(is (= 340 (get-in at [8 [:insert :mark]])))
|
||||
(is (= 610 (get-in at [11 [:insert :mark]])))
|
||||
(is (= (zipmap (range 12) (range -40 80 10))
|
||||
(into {} (map (fn [[f ops]] [f (js/Math.round (:plate ops))])) at)))
|
||||
(is (nil? (get-in at [4 [:a :mark]])) "half-open cuts have a single owner")))
|
||||
|
||||
(deftest exposure-ripple-keeps-lane-keys-and-moves-occurrence-corrections
|
||||
(let [doc (document)
|
||||
result (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol})
|
||||
after (:clip result)
|
||||
nodes (get-in after [:symbols :main :nodes])]
|
||||
(is (= :a (:selection result)))
|
||||
(is (= 14 (get-in after [:symbols :main :frames])))
|
||||
(is (= [0 6] (node/placed-span (:a nodes))))
|
||||
(is (= [6 10] (node/placed-span (:b nodes))))
|
||||
(is (= [10 14] (node/placed-span (:insert nodes))))
|
||||
(doseq [id [:girl :a :b :insert :plate]]
|
||||
(is (= (get-in doc [:symbols :main :nodes id :channels]) (:channels (nodes id))))
|
||||
(is (= (get-in doc [:symbols :main :nodes id :playback]) (:playback (nodes id)))))
|
||||
(let [at (sample after [5 6 7 10])]
|
||||
(is (= 60 (get-in at [5 [:a :mark]])))
|
||||
(is (= 80 (get-in at [6 [:b :mark]])))
|
||||
(is (= 72 (get-in at [7 [:b :mark]])) "B's correction follows B")
|
||||
(is (= 320 (get-in at [10 [:insert :mark]])) "insert starts on source frame 3"))
|
||||
(is (empty? (clip/problems after)))
|
||||
(is (= (assoc-in doc [:symbols :main :frames] 14)
|
||||
(:clip (sequence/extend-hold after :main :a -2 {})))
|
||||
"shrinking restores content, except the explicitly grown shot")))
|
||||
|
||||
(deftest overflow-and-invalid-edits-are-atomic
|
||||
(let [doc (document)
|
||||
result (sequence/extend-hold doc :main :a 2 {})]
|
||||
(is (:refused result))
|
||||
(is (= 14 (:required-frames result)))
|
||||
(is (not (contains? result :clip)))
|
||||
(doseq [delta [0 -4 0.5 js/NaN]]
|
||||
(is (:refused (sequence/extend-hold doc :main :a delta {}))))
|
||||
(is (:refused (sequence/extend-hold doc :main :insert 1 {})))
|
||||
(is (:refused (sequence/extend-hold doc :main :missing 1 {})))))
|
||||
|
||||
(deftest a-gap-is-an-uncovered-interval
|
||||
(let [doc (update-in (document) [:symbols :main :nodes] dissoc :b)
|
||||
at (sample doc [3 4 7 8])]
|
||||
(is (= #{:plate} (set (keys (at 4)))))
|
||||
(is (= #{:plate} (set (keys (at 7)))))
|
||||
(is (get-in at [8 [:insert :mark]]))
|
||||
(is (empty? (clip/problems doc)))))
|
||||
|
||||
(deftest validation-rejects-overlap-but-allows-empty-lanes
|
||||
(is (some #(re-find #"overlap" %)
|
||||
(clip/problems (assoc-in (document) [:symbols :main :nodes :b :time :at] 3))))
|
||||
(is (empty? (clip/problems
|
||||
(update-in (document) [:symbols :main :nodes] dissoc :a :b :insert))))
|
||||
(is (seq (clip/problems
|
||||
(assoc-in (document) [:symbols :main :nodes :a :span] [0 ##Inf]))))
|
||||
(is (seq (clip/problems
|
||||
(assoc-in (document) [:symbols :main :nodes :a :playback :speed] -1))))
|
||||
(is (seq (node/problems {:id :old :kind :instance :z "a"
|
||||
:channels {[:source] (ch/framed {:of :wave :in 0})}}))
|
||||
"the obsolete format is rejected"))
|
||||
|
||||
(deftest playback-is-independent-of-property-channel-shape
|
||||
(let [doc (document)
|
||||
n (get-in doc [:symbols :main :nodes :a])
|
||||
keyed (node/toggle-key n [:xform :rot] 0 nil)
|
||||
unkeyed (node/toggle-key keyed [:xform :rot] 0 nil)]
|
||||
(doseq [n [n keyed unkeyed]]
|
||||
(is (= {:symbol :drawing-a :frame 0} (node/placed-frame n 11 1))))
|
||||
(let [n (get-in doc [:symbols :main :nodes :insert])]
|
||||
(is (= {:symbol :wave :frame 5} (node/placed-frame n 2 10)))
|
||||
(is (nil? (node/placed-frame n 7 10)))
|
||||
(is (= 9 (:frame (node/placed-frame (assoc-in n [:playback :end] :hold) 9 10))))
|
||||
(is (= 2 (:frame (node/placed-frame (assoc-in n [:playback :end] :loop) 9 10)))))))
|
||||
|
||||
(deftest navigation-and-hit-testing-use-the-same-source-time
|
||||
(let [doc (document)
|
||||
n (get-in doc [:symbols :main :nodes :insert])]
|
||||
(is (= 5 (:frame (nest/inside doc nil :main [:insert] 10))))
|
||||
(is (= {:at 5 :rate 1} (:time (nest/inside doc nil :main [:insert] 10))))
|
||||
(is (= 0 (:frame (nest/inside doc nil :main [:a] 3))))
|
||||
(is (nil? (:time (nest/inside doc nil :main [:a] 3))))
|
||||
(is (nil? (nest/inside doc nil :main [:a] 4)))
|
||||
(is (= ((pick/bounds-of doc nil n) 2)
|
||||
((pick/bounds-of doc nil (assoc-in n [:playback :in] 5)) 0)))))
|
||||
|
||||
(deftest seeking-and-source-reuse-do-not-share-cursors
|
||||
(let [doc (assoc-in (document) [:symbols :main :nodes :b :source :symbol] :drawing-a)
|
||||
fs [11 0 5 3 8 4 10 1 6 2 9 7]
|
||||
at (sample doc fs)]
|
||||
(is (= at (sample doc (reverse fs))))
|
||||
(is (= at (sample doc (range 12))))
|
||||
(let [edited (assoc-in doc [:symbols :drawing-a :nodes :mark :channels [:xform :pos]]
|
||||
(ch/framed [99 0]))]
|
||||
(is (= 99 (get-in (sample edited [0 4]) [0 [:a :mark]])))
|
||||
(is (= 139 (get-in (sample edited [0 4]) [4 [:b :mark]]))))))
|
||||
|
||||
(deftest occurrence-identities-and-playback-round-trip
|
||||
(let [doc (:clip (sequence/extend-hold (document) :main :a 2 {:extent :grow-symbol}))
|
||||
leaves (leaf/leaves :project doc)]
|
||||
(is (= doc (leaf/clip :project leaves)))
|
||||
(is (contains? leaves "clip/project/symbol/main/node/a"))
|
||||
(is (not (contains? leaves "clip/project/symbol/main/channel/girl/source")))
|
||||
(let [{copied :clip ids :ids}
|
||||
(bring/symbols (assoc-in (clip/blank) [:symbols :drawing-a] (drawing :drawing-a 99 1))
|
||||
doc [:main] {})]
|
||||
(is (= :drawing-a-2 (:drawing-a ids)))
|
||||
(is (= #{:drawing-a-2 :drawing-b :wave} (clip/places copied (:main ids))))
|
||||
(is (empty? (clip/problems copied))))))
|
||||
|
||||
(deftest one-transaction-undoes-the-ripple-and-shot-extension
|
||||
(let [doc (document)
|
||||
after (:clip (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol}))
|
||||
before-leaves (leaf/leaves :p doc)
|
||||
after-leaves (leaf/leaves :p after)
|
||||
h (-> nil history/hold (history/record before-leaves after-leaves 0) history/settle)
|
||||
undo (history/undo h after-leaves)
|
||||
redo (history/redo (:history undo) (:leaves undo))]
|
||||
(is (= 1 (count (:done h))))
|
||||
(is (= before-leaves (:leaves undo)))
|
||||
(is (= after-leaves (:leaves redo)))))
|
||||
|
||||
(deftest create-lane-and-append-drawings
|
||||
(let [doc (:clip (sequence/add-lane (clip/blank) :main :girl))
|
||||
a (:clip (sequence/append-drawing doc :main :girl :a :drawing-a {}))
|
||||
b (:clip (sequence/append-drawing a :main :girl :b :drawing-b {}))]
|
||||
(is (empty? (clip/problems b)))
|
||||
(is (= [1 2] (node/placed-span (get-in b [:symbols :main :nodes :b]))))
|
||||
(is (= 0 (get-in b [:symbols :main :nodes :b :playback :speed])))
|
||||
(is (:refused (sequence/append-drawing b :main :girl :a :new {})))))
|
||||
|
||||
(deftest fractional-placement-rates-convert-the-hold-delta
|
||||
(let [doc (-> (document)
|
||||
(assoc-in [:symbols :main :nodes :a :time :rate] 2)
|
||||
(assoc-in [:symbols :main :nodes :a :span] [0 8]))
|
||||
after (:clip (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol}))]
|
||||
(is (= [0 12] (get-in after [:symbols :main :nodes :a :span])))
|
||||
(is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :b]))))))
|
||||
|
||||
(deftest bare-shapes-agree-in-reference-and-playback
|
||||
(let [sym (drawing :bare 12 1)]
|
||||
(is (= (symbol/eval-frame sym 0 nil pal/index-of nil)
|
||||
((symbol/resolver sym nil pal/index-of nil) 0))
|
||||
"omitted style colour must not crash a missing cursor")))
|
||||
|
||||
(deftest audio-follows-only-the-playing-occurrence
|
||||
(let [voice {:id :voice :kind :audio :z "a" :source {:sound "voice"}
|
||||
:span [0 10]
|
||||
:channels {[:audio :gain] (ch/keyed {0 0 5 1} :linear)}}
|
||||
doc (-> (document)
|
||||
(assoc-in [:symbols :wave :nodes :voice] voice)
|
||||
(assoc-in [:symbols :drawing-a :nodes :voice] voice))
|
||||
[track :as tracks] (nest/audio-tracks doc :main)]
|
||||
(is (= 1 (count tracks)) "the frozen drawing contributes no audio")
|
||||
(is (= [8 12] (node/placed-span track)))
|
||||
(is (= [3 7] (:span track)) "the source in-point trims the audio too")
|
||||
(is (= {5 0 10 1} (get-in track [:channels [:audio :gain] :keys])))
|
||||
(let [moved (:clip (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol}))
|
||||
[track] (nest/audio-tracks moved :main)]
|
||||
(is (= [10 14] (node/placed-span track)))
|
||||
(is (= [3 7] (:span track))))
|
||||
(let [fast (-> doc
|
||||
(assoc-in [:symbols :main :nodes :girl :time] {:at 2 :rate 2})
|
||||
(assoc-in [:symbols :main :nodes :insert :playback :speed] 2))
|
||||
[track] (nest/audio-tracks fast :main)]
|
||||
(is (= [6 7.75] (node/placed-span track)))
|
||||
(is (= [3 10] (:span track)))
|
||||
(is (= 4 (get-in track [:time :rate]))))))
|
||||
|
||||
(deftest a-looped-insert-schedules-distinct-audio-intervals
|
||||
(let [doc (-> (document)
|
||||
(assoc-in [:symbols :wave :frames] 4)
|
||||
(assoc-in [:symbols :wave :nodes :voice]
|
||||
{:id :voice :kind :audio :z "a" :source {:sound "v"} :span [1 3]})
|
||||
(assoc-in [:symbols :main :nodes :insert :playback]
|
||||
{:in 3 :speed 1 :end :loop}))]
|
||||
(is (= [[10 12]] (mapv node/placed-span (nest/audio-tracks doc :main))))))
|
||||
|
||||
(deftest enclosing-retiming-is-respected-when-extending-the-shot
|
||||
(let [doc (assoc-in (document) [:symbols :main :nodes :girl :time] {:at 8 :rate 2})
|
||||
result (sequence/extend-hold doc :main :a 2 {})]
|
||||
(is (= 15 (:required-frames result)))
|
||||
(is (nil? (:clip result)))
|
||||
(is (= 15 (get-in (sequence/extend-hold doc :main :a 2 {:extent :grow-symbol})
|
||||
[:clip :symbols :main :frames])))))
|
||||
|
|
@ -34,7 +34,12 @@
|
|||
;; No node leaves, and still `:nodes {}`: nil there is what `symbol/nodes-of`
|
||||
;; refuses, so a saved blank document would not open.
|
||||
(is (= (get-in (clip/blank) [:symbols :main])
|
||||
(get-in (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))) [:symbols :main]))))
|
||||
(get-in (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))) [:symbols :main])))
|
||||
;; And the WHOLE blank document, not only its symbol. An empty field that the
|
||||
;; codec cannot write is an empty field it cannot restore, so a blank document
|
||||
;; carrying one comes back unequal to itself — which undo, whose steps are
|
||||
;; leaves, then reports as a document change nobody made.
|
||||
(is (= (clip/blank) (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))))))
|
||||
|
||||
(deftest the-leaves-are-the-paths-the-sync-design-names
|
||||
(let [ls (leaf/leaves :c7 @take/clip)]
|
||||
|
|
@ -115,8 +120,9 @@
|
|||
;; right in a log and resolves nothing: `:linked-to` dangles and an export target
|
||||
;; matches no node, with no error anywhere.
|
||||
(let [u #uuid "8f594d72-a97f-4a32-82fd-08d1670a2218"
|
||||
c (one-symbol {u {:id u :kind :instance :of :sym/face-8625 :parent nil
|
||||
:z "a1" :name "8625 bottom left"}})
|
||||
c (one-symbol {u {:id u :kind :instance :parent nil
|
||||
:z "a1" :name "8625 bottom left"
|
||||
:source {:symbol :sym/face-8625}}})
|
||||
ls (leaf/leaves :c1 c)]
|
||||
(is (contains? ls (str "clip/c1/symbol/main/node/" u))
|
||||
"written plainly, with no sigil")
|
||||
|
|
|
|||
|
|
@ -93,8 +93,8 @@
|
|||
[t] (nest/audio-tracks c :main)]
|
||||
(is (= [10 40] (:span t)) "the same frames of the source")
|
||||
(is (= [50 80] (node/placed-span t)) "starting where the instance starts")
|
||||
(is (= #{50 55} (set (keys (get-in t [:channels [:audio :gain] :keys]))))
|
||||
"with its automation moved along")
|
||||
(is (= #{40 45} (set (keys (get-in t [:channels [:audio :gain] :keys]))))
|
||||
"automation is in the sound's own clock, including its source offset")
|
||||
(testing "and cut off where the instance's own span ends"
|
||||
(let [c (assoc-in c [:symbols :main :nodes #uuid "00000000-0000-4000-8000-0000000000bb" :span] [0 12])
|
||||
[t] (nest/audio-tracks c :main)]
|
||||
|
|
|
|||
|
|
@ -74,7 +74,8 @@
|
|||
[]
|
||||
(assoc-in @frozen [:symbols :wrap]
|
||||
{:id :wrap :frames 200
|
||||
:nodes {:m {:id :m :kind :instance :of :main :z "a0"
|
||||
:nodes {:m {:id :m :kind :instance :z "a0"
|
||||
:source {:symbol :main}
|
||||
:channels {[:xform :pos] {:animated? false :value [30 -10]}}}}}))
|
||||
|
||||
(deftest a-face-switched-on-shows-wherever-it-is-placed
|
||||
|
|
|
|||
|
|
@ -60,12 +60,14 @@
|
|||
:nodes {:root {:id :root :kind :group :z "a1"}
|
||||
#uuid "22222222-2222-4222-8222-222222222222"
|
||||
{:id #uuid "22222222-2222-4222-8222-222222222222"
|
||||
:kind :instance :of :sym/face :parent :root :z "a2"
|
||||
:name "8625 right"}
|
||||
:kind :instance :parent :root :z "a2"
|
||||
:name "8625 right"
|
||||
:source {:symbol :sym/face}}
|
||||
#uuid "11111111-1111-4111-8111-111111111111"
|
||||
{:id #uuid "11111111-1111-4111-8111-111111111111"
|
||||
:kind :instance :of :sym/face :parent :root :z "a1"
|
||||
:name "8625 left"}
|
||||
:kind :instance :parent :root :z "a1"
|
||||
:name "8625 left"
|
||||
:source {:symbol :sym/face}}
|
||||
:a-rect {:id :a-rect :kind :rect :parent :root :z "a3"}}}
|
||||
:sym/face {:frames 40 :nodes {:root {:id :root :kind :group :z "a1"}}}}})
|
||||
|
||||
|
|
|
|||
42
frontend/test/arthur/events/sequence_test.cljs
Normal file
42
frontend/test/arthur/events/sequence_test.cljs
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
(ns arthur.events.sequence-test
|
||||
(:require [cljs.test :refer [deftest is]]
|
||||
[arthur.domain.lane-test :as fixture]
|
||||
[arthur.domain.sequence :as sequence]
|
||||
[arthur.events.ui :as ui]
|
||||
[arthur.domain.history :as history]
|
||||
[arthur.domain.leaf :as leaf]
|
||||
[arthur.footage.store :as store]
|
||||
[arthur.ui.timeline :as timeline]))
|
||||
|
||||
(deftest one-row-projects-all-occurrences-and-keeps-selection-addresses
|
||||
(let [doc (fixture/document)
|
||||
rows (timeline/rows doc :main #{})
|
||||
lane (first (filter :cels rows))]
|
||||
(is (= 2 (count rows)))
|
||||
(is (= [[0 4] [4 8] [8 12]] (mapv :span (:cels lane))))
|
||||
(is (= [[:node :main :a [:a]] [:node :main :b [:b]] [:node :main :insert [:insert]]]
|
||||
(mapv :select (:cels lane))))
|
||||
(is (= [0 6 12] (:keys lane)))
|
||||
(is (= 1 (count (filter :cels (timeline/rows doc :main #{[:girl]})))))))
|
||||
|
||||
(deftest sequence-commands-use-isolated-history-transactions
|
||||
(let [doc (fixture/document)
|
||||
id (store/install! {:clip doc :store {}} "sequence-test")
|
||||
db {:clip/current id :paint/revision 0
|
||||
:ui {:open :main :selection [:node :main :a [:a]]}}
|
||||
refused (ui/apply-sequence-command db :main
|
||||
(sequence/extend-hold doc :main :a 1 {}) [:retry])]
|
||||
(is (= doc (:clip (store/entry id))))
|
||||
(is (nil? (:history (store/entry id))))
|
||||
(is (= [:retry] (get-in refused [:ui :sequence-retry])))
|
||||
(let [r1 (sequence/extend-hold doc :main :a 1 {:extent :grow-symbol})
|
||||
db1 (ui/apply-sequence-command db :main r1 nil)
|
||||
r2 (sequence/extend-hold (:clip r1) :main :a 1 {:extent :grow-symbol})
|
||||
db2 (ui/apply-sequence-command db1 :main r2 nil)
|
||||
h (:history (store/entry id))
|
||||
undo (history/undo h (leaf/leaves "u" (:clip r2)))
|
||||
undo2 (history/undo (:history undo) (:leaves undo))]
|
||||
(is (= 2 (count (:done h))) "rapid button presses remain separate commands")
|
||||
(is (= (:clip r1) (leaf/clip "u" (:leaves undo))))
|
||||
(is (= doc (leaf/clip "u" (:leaves undo2))))
|
||||
(is (= [:node :main :a [:a]] (get-in db2 [:ui :selection]))))))
|
||||
|
|
@ -222,10 +222,12 @@
|
|||
{:main
|
||||
{:frames 12
|
||||
:nodes (cond-> {:root {:id :root :kind :group :z "a1"}
|
||||
p1 {:id p1 :kind :instance :of :sym/face :parent :root :z "a1"
|
||||
:name "left" :channels {[:xform :pos] (ch/framed [0 0])}}
|
||||
p2 {:id p2 :kind :instance :of :sym/face :parent :root :z "a2"
|
||||
:name "right" :channels {[:xform :pos] (ch/framed [4 0])}}
|
||||
p1 {:id p1 :kind :instance :parent :root :z "a1"
|
||||
:name "left" :source {:symbol :sym/face}
|
||||
:channels {[:xform :pos] (ch/framed [0 0])}}
|
||||
p2 {:id p2 :kind :instance :parent :root :z "a2"
|
||||
:name "right" :source {:symbol :sym/face}
|
||||
:channels {[:xform :pos] (ch/framed [4 0])}}
|
||||
:loose (assoc (poly :loose "a4" [0 0 1 0 1 1] :brow)
|
||||
:parent :root)}
|
||||
voice? (assoc v1 {:id v1 :kind :audio :parent :root :z "a3"
|
||||
|
|
|
|||
|
|
@ -87,7 +87,7 @@
|
|||
|
||||
(deftest the-tree-is-the-one-the-model-specifies
|
||||
(is (= [:face :root] (symbol/lineage (:nodes (clip/symbol @clip* :main)) :face)))
|
||||
(is (= :face-1 (get-in @clip* [:symbols :main :nodes :face-1 :of])))
|
||||
(is (= #{:face-1} (node/sources (get-in @clip* [:symbols :main :nodes :face-1]))))
|
||||
(is (= [:head] (symbol/lineage (:nodes @sym*) :head)))
|
||||
(is (= [:mouth :head] (symbol/lineage (:nodes @sym*) :mouth)))
|
||||
(is (= [:mouth-in :mouth :head] (symbol/lineage (:nodes @sym*) :mouth-in)))
|
||||
|
|
|
|||
131
frontend/test/browser/sequence.mjs
Normal file
131
frontend/test/browser/sequence.mjs
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
// Local editor smoke test. Uses the in-memory blank document and disables the
|
||||
// project route, so it never creates an account, project, or server-side write.
|
||||
import { spawn } from 'node:child_process';
|
||||
import { mkdtempSync, rmSync } from 'node:fs';
|
||||
import { tmpdir } from 'node:os';
|
||||
import { join } from 'node:path';
|
||||
import assert from 'node:assert/strict';
|
||||
|
||||
const url = process.env.ARTHUR_URL ?? 'http://localhost:8778/';
|
||||
const profile = mkdtempSync(join(tmpdir(), 'arthur-sequence-'));
|
||||
const port = 9335;
|
||||
const chrome = spawn(process.env.CHROME ?? '/usr/bin/chromium', [
|
||||
'--headless=new', '--no-sandbox', '--disable-gpu', '--no-first-run',
|
||||
'--no-default-browser-check', '--mute-audio', '--window-size=1440,1000',
|
||||
`--user-data-dir=${profile}`, `--remote-debugging-port=${port}`, url,
|
||||
], { stdio: 'ignore' });
|
||||
const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));
|
||||
let ws;
|
||||
try {
|
||||
let target;
|
||||
for (let i = 0; i < 100 && !target; i++) {
|
||||
await sleep(100);
|
||||
try {
|
||||
target = (await fetch(`http://127.0.0.1:${port}/json/list`).then(r => r.json()))
|
||||
.find(t => t.type === 'page' && t.url.startsWith(url));
|
||||
} catch { /* browser starting */ }
|
||||
}
|
||||
assert(target, 'browser exposes the editor page');
|
||||
ws = new WebSocket(target.webSocketDebuggerUrl);
|
||||
await new Promise((resolve, reject) => { ws.onopen = resolve; ws.onerror = reject; });
|
||||
let serial = 0;
|
||||
const pending = new Map();
|
||||
const errors = [];
|
||||
ws.onmessage = ({ data }) => {
|
||||
const msg = JSON.parse(data);
|
||||
if (msg.method === 'Runtime.exceptionThrown') errors.push(msg.params.exceptionDetails);
|
||||
if (msg.id && pending.has(msg.id)) {
|
||||
const { resolve, reject } = pending.get(msg.id);
|
||||
pending.delete(msg.id);
|
||||
if (msg.error) reject(new Error(JSON.stringify(msg.error)));
|
||||
else resolve(msg.result);
|
||||
}
|
||||
};
|
||||
const send = (method, params = {}) => new Promise((resolve, reject) => {
|
||||
const id = ++serial;
|
||||
pending.set(id, { resolve, reject });
|
||||
ws.send(JSON.stringify({ id, method, params }));
|
||||
});
|
||||
const evaluate = async expression => {
|
||||
const r = await send('Runtime.evaluate', { expression, returnByValue: true, awaitPromise: true });
|
||||
if (r.exceptionDetails) throw new Error(JSON.stringify(r.exceptionDetails));
|
||||
return r.result.value;
|
||||
};
|
||||
await send('Runtime.enable');
|
||||
for (let i = 0; i < 100; i++) {
|
||||
if (await evaluate('typeof arthur !== "undefined" && !!arthur.events?.ui && !!document.querySelector("canvas.stage")')) break;
|
||||
await sleep(100);
|
||||
}
|
||||
await evaluate(`(() => {
|
||||
const k = cljs.core.keyword;
|
||||
cljs.core.swap_BANG_(re_frame.db.app_db, db => cljs.core.assoc(db, k('route'), k('local-test')));
|
||||
window.sequenceSnapshot = () => {
|
||||
const db = cljs.core.deref(re_frame.db.app_db);
|
||||
const entry = arthur.footage.store.entry(cljs.core.get(db, k('clip/current')));
|
||||
return cljs.core.clj__GT_js(entry);
|
||||
};
|
||||
return true;
|
||||
})()`);
|
||||
await sleep(250);
|
||||
const click = async label => {
|
||||
assert(await evaluate(`(() => {
|
||||
const b = [...document.querySelectorAll('button')].find(b => b.textContent.trim() === ${JSON.stringify(label)});
|
||||
if (!b || b.disabled) return false;
|
||||
b.click(); return true;
|
||||
})()`), `enabled button: ${label}`);
|
||||
await sleep(180);
|
||||
};
|
||||
const shot = async () => (await evaluate('sequenceSnapshot()'));
|
||||
const instances = s => Object.values(s.clip.symbols.main.nodes).filter(n => n.kind === 'instance')
|
||||
.sort((a, b) => a.time.at - b.time.at);
|
||||
await click('+ lane');
|
||||
await click('new drawing');
|
||||
await click('hold +');
|
||||
await click('hold +');
|
||||
await click('hold +');
|
||||
await click('new drawing');
|
||||
let s = await shot();
|
||||
assert.deepEqual(instances(s).map(n => [n.time.at, n.span[1]]), [[0, 4], [4, 1]]);
|
||||
assert.equal(await evaluate('document.querySelectorAll(".tl-cel").length'), 2);
|
||||
assert.equal(await evaluate('document.querySelectorAll(".tl-label:not(.tl-corner)").length'), 1);
|
||||
assert.equal(await evaluate(`cljs.core.get_in(cljs.core.deref(re_frame.db.app_db),
|
||||
cljs.core.vector(cljs.core.keyword('playback'), cljs.core.keyword('frame')))`), 4,
|
||||
'new drawing seeks to its occurrence');
|
||||
|
||||
// Shorten this test shot to the occupied extent, purely in memory.
|
||||
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')), 5));
|
||||
document.querySelector('.tl-cel').click();
|
||||
})()`);
|
||||
await sleep(200);
|
||||
const before = await shot();
|
||||
await click('hold +');
|
||||
s = await shot();
|
||||
assert.deepEqual(s.clip, before.clip, 'refused overflow makes no document change');
|
||||
assert.equal(s.history.done.length, before.history.done.length);
|
||||
await click('extend shot and apply');
|
||||
s = await shot();
|
||||
assert.equal(s.clip.symbols.main.frames, 6);
|
||||
assert.deepEqual(instances(s).map(n => [n.time.at, n.span[1]]), [[0, 5], [5, 1]]);
|
||||
assert.equal(s.history.done.length, before.history.done.length + 1);
|
||||
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');
|
||||
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');
|
||||
} finally {
|
||||
if (ws?.readyState === WebSocket.OPEN) {
|
||||
ws.send(JSON.stringify({ id: 999999, method: 'Browser.close' }));
|
||||
await sleep(350);
|
||||
}
|
||||
ws?.close();
|
||||
chrome.kill();
|
||||
await new Promise(resolve => { if (chrome.exitCode !== null || chrome.signalCode !== null) resolve(); else chrome.once('exit', resolve); });
|
||||
try {
|
||||
rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 });
|
||||
} catch (error) {
|
||||
console.warn(`Temporary browser profile retained at ${profile}: ${error.code}`);
|
||||
}
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue