diff --git a/frontend/src/arthur/audio/mix.cljs b/frontend/src/arthur/audio/mix.cljs index 9706eda..06b2bcd 100644 --- a/frontend/src/arthur/audio/mix.cljs +++ b/frontend/src/arthur/audio/mix.cljs @@ -12,6 +12,7 @@ than the render being spelled once per consumer." (:require [arthur.domain.channel :as ch] [arthur.domain.clip :as clip] + [arthur.domain.nest :as nest] [arthur.domain.node :as node])) (defn wav-bytes @@ -92,9 +93,9 @@ (defn tracks-of "The sounds symbol `sid` plays, including those inside what it places — see - `clip/audio-tracks`. Playback mixes the open symbol's." + `nest/audio-tracks`. Playback mixes the open symbol's." [document sid] - (clip/audio-tracks document sid)) + (nest/audio-tracks document sid)) (defn- render! [document sid sources store] (let [fps (:fps document) diff --git a/frontend/src/arthur/domain/bring.cljs b/frontend/src/arthur/domain/bring.cljs new file mode 100644 index 0000000..5882d2d --- /dev/null +++ b/frontend/src/arthur/domain/bring.cljs @@ -0,0 +1,98 @@ +(ns arthur.domain.bring + "Bringing symbols into a clip from another: out of a saved project, or out of + a freeze of new footage. + + Copied, never linked. What comes in gets ids of its own where they are taken, + and editing it here does not touch where it came from. Tracking identities and + the analysis they were measured by come along only when the receiving clip can + hold them; otherwise what comes in is drawing, which plays but does not re-tune. + + Plain data in and out — documents, and in `placed` a document with its store — + so the events that fetch them are only fetching." + (:refer-clojure :exclude [take]) + (:require [arthur.domain.clip :as clip] + [clojure.string :as string])) + +(defn symbols + "Copy symbols `roots` of clip `other`, and every symbol they place, into + `clip`. Returns `{:clip :ids}`, where `:ids` maps each copied symbol's id in + `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, + which is how a symbol made from footage is called what the person typed rather + than `:main`. + + Only symbols travel. What else `other` holds — tracking identities, an analysis + — is the caller's decision, because whether it can come too depends on what + `clip` already has." + [clip other roots wanted] + (let [;; A tree walk is safe because placing cannot make a cycle. + reach (into #{} (mapcat #(tree-seq any? (partial clip/places other) %)) roots) + ids (reduce (fn [ids sid] + (let [taken? #(or (contains? (:symbols clip) %) + (some #{%} (vals ids)))] + (assoc ids sid (clip/free-id taken? (get wanted sid sid))))) + {} (sort-by str reach)) + 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))])) + %))))] + {:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach) + :ids ids})) + +(defn symbol-id + "An id for a symbol a person has named: the name, lower-cased and hyphenated, + or `:symbol` when nothing of it survives." + [label] + (let [slug (-> (str label) string/lower-case + (string/replace #"[^a-z0-9]+" "-") + (string/replace #"^-+|-+$" ""))] + (keyword (if (seq slug) slug "symbol")))) + +(defn take + "Put `frozen`, a take, into `clip` as ONE symbol called `label`. Returns + `{:clip :sid :tracked?}`. + + `frozen` is what `flow/freeze/clip` makes: a `:main` that places one symbol per + tracked face. `:main` becomes the named symbol — it is what holds the faces in + stage pixels, so it is the thing worth placing — and it gets the take's SOUND + as an audio node of its own, source frames `range` of footage `footage-id`, so + wherever the symbol is placed it is heard. + + The tracking identities, and the analysis they were measured by, come along + only when `clip` has no analysis of its own and no face had to be renamed. A + document holds one analysis, and regeneration finds a face's symbol by its + subject id, so either condition failing means the take comes in as drawings + that play but cannot be re-tuned — `:tracked? false` says so." + [clip frozen label footage-id range] + (let [{c :clip ids :ids} (symbols clip frozen [:main] {:main (symbol-id label)}) + sid (ids :main) + tracked? (and (nil? (:analysis clip)) + (every? #(= % (ids %)) (keys (:subjects frozen))))] + {:sid sid + :tracked? tracked? + :clip (cond-> (-> c + (assoc-in [:symbols sid :name] (str label)) + (assoc-in [:symbols sid :nodes :sound] + {:id :sound :name "sound" :kind :audio :parent nil + :z "z-sound" :source {:footage footage-id} + ;; Source frame `start` plays on the symbol's 0. + :span range :time {:mode :map :at (- (first range)) :rate 1}})) + tracked? (-> (assoc :analysis (:analysis frozen)) + (update :subjects merge (:subjects frozen)) + (update :features merge (:features frozen)) + (update :groups merge (:groups frozen))))})) + + +(defn placed + "`entry` — a document and its store — once `brought` holds the symbols brought + in and `store` their blocks: the stores merged and an instance of `sid` placed + in `host` at `frame`, its middle on stage pixel `point` or where it was drawn + when there is none. See `clip/place-symbol`." + [entry brought store sid host frame uuid point] + (let [st (merge (:store entry) store)] + (assoc entry :store st :clip (clip/place-symbol brought st host sid frame uuid point)))) diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index 0c5a03d..1c551f2 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -20,6 +20,11 @@ a MAP of them. A `:kind :instance` node places one symbol inside another, and the clip resolver gives each instance its own reading heads. + WHAT IS NOT HERE: how nested symbols' frames and coordinates relate, and + moving nodes between them, are `arthur.domain.nest`; bringing symbols in from + another clip is `arthur.domain.bring`. This namespace is the document and the + operations that only need the document. + NO SYMBOL IS SPECIAL. There is no reserved root and no pointer to one: which symbol is on screen is the editor's state, not the document's, and every function here that needs a symbol is told which. A new document has one symbol @@ -37,8 +42,7 @@ [arthur.domain.node :as node] [arthur.domain.palette :as pal] [arthur.domain.pose :as pose] - [arthur.domain.symbol :as symbol] - [clojure.string :as string])) + [arthur.domain.symbol :as symbol])) (def clip-keys "Every top-level field of a clip, and the reason `arthur.domain.leaf` refuses @@ -122,7 +126,74 @@ :subjects {} :features {} :groups {} :symbols {:main {:id :main :frames blank-frames :nodes {}}}}) -(declare resolver) +(defn- transform-op + "Put a symbol's already resolved mark into its instance's parent space." + [op m path] + (let [at (fn [x y] [(+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4)) + (+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5))]) + scale (node/mean-scale m) + op (assoc op :node (conj path (:node op)))] + (case (:kind op) + :poly (let [out (js/Float64Array. (.-length (:pts op)))] + (dotimes [i (:n op)] + (let [[x y] (at (aget (:pts op) (* 2 i)) + (aget (:pts op) (inc (* 2 i))))] + (aset out (* 2 i) x) + (aset out (inc (* 2 i)) y))) + (assoc op :pts out)) + :disc (let [[x y] (at (:cx op) (:cy op))] + (assoc op :cx x :cy y :r (* scale (:r op)))) + :rect (let [[x y] (at (:cx op) (:cy op))] + (assoc op :cx x :cy y :size (* scale (:size op)))) + op))) + +(defn resolver + "Resolve symbol `sid` of a clip, including every symbol its instances place. + + Each instance owns its own symbol resolver, so two offsets never share a + channel cursor or point buffer. The returned ops must be drawn before the next + frame, as with symbol/resolver. + + Any symbol can be resolved and none is the default: the frame space is the + resolved symbol's own `:frames`, and nested instances inside it still resolve, + because this is the function that knows how to do that." + ([clip store palette sid] (resolver clip store palette sid nil)) + ([clip store palette sid {:keys [picture-fps] :as opts}] + (letfn [(build [sid chain pose-tracks] + (when (some #{sid} chain) + (throw (ex-info "symbol cycle" {:chain (conj chain sid)}))) + (let [sym (or (symbol clip sid) + (throw (ex-info "an instance names a missing symbol" {:symbol sid}))) + nodes (:nodes sym) + rank (symbol/draw-rank nodes (symbol/order nodes)) + ids (sort-by rank (keys nodes)) + own (symbol/resolver sym store palette pose-tracks + (assoc opts :source-fps (:fps clip))) + children (into {} + (for [[id n] nodes :when (= :instance (:kind n))] + [id (build (:of n) (conj chain sid) + (get-in n [:playback :tracks]))]))] + (fn [f] + (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) + 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))] + (if (and frame (<= 0 frame) (< frame length)) + (map #(transform-op % m [id]) ((get children id) frame)) + [])) + (when-let [op (get by-id id)] [op])))) + ids))))))] + (build sid [] nil)))) (defn center "The middle of everything symbol `sid` draws, over all its frames, in its own @@ -217,7 +288,7 @@ (assoc-in [:symbols sid] {:id sid :name (name sid) :frames (- end frame) :nodes {}}) (place-symbol nil host sid frame uuid nil))))) -(defn- free-id +(defn free-id "`wanted`, or the first `wanted-2`, `wanted-3`… `taken?` does not claim. Keeps the namespace, so `:sym/face` becomes `:sym/face-2`." [taken? wanted] @@ -226,409 +297,6 @@ (map #(keyword (namespace wanted) (str (name wanted) "-" %)) (iterate inc 2)))))) -(defn adopt - "Copy symbols `roots` of clip `other`, and every symbol they place, into - `clip`. Returns `{:clip :ids}`, where `:ids` maps each copied symbol's id in - `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, - which is how a symbol made from footage is called what the person typed rather - than `:main`. - - Only symbols travel. What else `other` holds — tracking identities, an analysis - — is the caller's decision, because whether it can come too depends on what - `clip` already has." - [clip other roots wanted] - (let [;; A tree walk is safe because placing cannot make a cycle. - reach (into #{} (mapcat #(tree-seq any? (partial places other) %)) roots) - ids (reduce (fn [ids sid] - (let [taken? #(or (contains? (:symbols clip) %) - (some #{%} (vals ids)))] - (assoc ids sid (free-id taken? (get wanted sid sid))))) - {} (sort-by str reach)) - copy (fn [sid] - (-> (symbol other sid) - (assoc :id (ids sid)) - (update :nodes #(into {} (map (fn [[id n]] - [id (cond-> n (:of n) (update :of ids))])) - %))))] - {:clip (reduce (fn [c sid] (assoc-in c [:symbols (ids sid)] (copy sid))) clip reach) - :ids ids})) - -(defn symbol-id - "An id for a symbol a person has named: the name, lower-cased and hyphenated, - or `:symbol` when nothing of it survives." - [label] - (let [slug (-> (str label) string/lower-case - (string/replace #"[^a-z0-9]+" "-") - (string/replace #"^-+|-+$" ""))] - (keyword (if (seq slug) slug "symbol")))) - -(defn add-take - "Put a frozen take into `clip` as ONE symbol called `label`. Returns - `{:clip :sid :tracked?}`. - - `take` is what `flow/freeze/clip` makes: a `:main` that places one symbol per - tracked face. `:main` becomes the named symbol — it is what holds the faces in - stage pixels, so it is the thing worth placing — and it gets the take's SOUND - as an audio node of its own, source frames `range` of footage `footage-id`, so - wherever the symbol is placed it is heard. - - The tracking identities, and the analysis they were measured by, come along - only when `clip` has no analysis of its own and no face had to be renamed. A - document holds one analysis, and regeneration finds a face's symbol by its - subject id, so either condition failing means the take comes in as drawings - that play but cannot be re-tuned — `:tracked? false` says so." - [clip take label footage-id range] - (let [{c :clip ids :ids} (adopt clip take [:main] {:main (symbol-id label)}) - sid (ids :main) - tracked? (and (nil? (:analysis clip)) - (every? #(= % (ids %)) (keys (:subjects take))))] - {:sid sid - :tracked? tracked? - :clip (cond-> (-> c - (assoc-in [:symbols sid :name] (str label)) - (assoc-in [:symbols sid :nodes :sound] - {:id :sound :name "sound" :kind :audio :parent nil - :z "z-sound" :source {:footage footage-id} - ;; Source frame `start` plays on the symbol's 0. - :span range :time {:mode :map :at (- (first range)) :rate 1}})) - tracked? (-> (assoc :analysis (:analysis take)) - (update :subjects merge (:subjects take)) - (update :features merge (:features take)) - (update :groups merge (:groups take))))})) - -(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." - [clip sid] - (let [sym (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 (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))))))) - -(defn inside - "Carry frame `f` of symbol `sid` down through the instances named by `path`, - one per level, the way a timeline row's path names them. Returns - `{:sid :frame :matrix}`: the symbol the last one places, the frame it is showing - there, and the matrix from its coordinates to `sid`'s — or nil when one of the - instances is not on screen at that frame, where there is no inside to be in. - - Walked by RESOLVING each level, so the frame and the matrix are the ones the - stage draws with, time maps, parents and exposure included, rather than a - second account of them that could disagree." - [clip store sid path f] - (reduce (fn [{:keys [sid frame matrix]} id] - (let [r (symbol/resolver (symbol clip sid) store pal/index-of nil - {:source-fps (:fps clip)}) - _ (r frame) - m (symbol/world-of r id) - local (symbol/frame-of r id) - inner (get-in clip [:symbols sid :nodes id :of])] - (if (and m (number? local) inner (< -1 local (frames clip inner))) - {:sid inner :frame (js/Math.floor local) - :matrix (node/mul! (node/mat) matrix m)} - (reduced nil)))) - {:sid sid :frame f :matrix (node/mat)} - path)) - -(defn- invert - "The inverse of a 2x3 affine, or nil when it has none — an instance scaled to - nothing has no inside to draw into." - [^js m] - (let [[a b c d e f] (array-seq m) - det (- (* a d) (* b c))] - (when-not (zero? det) - (js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det) - (/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)])))) - -(defn drawn-inside - "Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the - symbol `path` leads to, so a shape added there lands exactly where it was drawn. - `{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside." - [clip store sid path f pts] - (when-let [{:keys [matrix] :as at} (inside clip store sid path f)] - (when-let [inv (invert matrix)] - (let [out (js/Float64Array. 2)] - (assoc (select-keys at [:sid :frame]) - :pts (into [] (mapcat (fn [[x y]] - (node/apply-pt! out 0 inv x y) - [(aget out 0) (aget out 1)])) - (partition 2 pts))))))) - -;; --------------------------------------------------------------------------- -;; reparenting -;; -;; ONE NESTING, AS FAR AS A PERSON IS CONCERNED. Putting a node inside another -;; symbol is how things are grouped: the symbol is a shared timeline, and its -;; instance is the handle that moves, retimes and transforms everything in it -;; together. Parent pointers inside a symbol stay — the roto rig is built on them -;; — but they are not something the timeline hands out. -;; -;; A MOVE CHANGES NEITHER THE PICTURE NOR THE TIMING. Space: the node keeps its -;; own channels and gains a `:pinv`, the matrix from where it was to where it -;; goes, which is Blender's parent-inverse and what `node/world!` has always -;; applied. Time: its frames shift by the difference between the two symbols' -;; time maps — its keys and span if it is a shape, only its `:at` if it is an -;; instance, whose span is in its own frames and does not move at all. - -(defn- time-down - "The time map from symbol `sid` down through the instances `path` names: the - frame of the last one's symbol for each frame of `sid`. Each step is the - instance's own map after its parents' in that symbol, so the map is the one - the stage reads with, floors aside. Nil through a looping instance, whose - frames come round again and do not map one to one." - [clip sid path] - (:down - (reduce (fn [{:keys [sid down]} id] - (let [nodes (:nodes (symbol clip sid)) - chain (map #(get nodes %) (rseq (symbol/lineage nodes id)))] - (if (some #(get-in % [:time :loop?]) chain) - (reduced {:down nil}) - {:sid (:of (get nodes id)) - :down (reduce node/then-time down (map node/time-of chain))}))) - {:sid sid :down {:at 0 :rate 1}} - path))) - -(defn- retime - "Node `n` with its own time map replaced by `m`, and nothing else touched: its - span and keys are in its own frames, which a move does not change." - [n {:keys [at rate]}] - (assoc n :time (merge (:time n) {:mode :map :at at :rate rate :offset 0}))) - -(defn- subtree - "`id` and every node whose parent chain reaches it." - [nodes id] - (into #{} (filter #(some #{id} (symbol/lineage nodes %))) (keys nodes))) - -(defn- transplant - "Move node `id` from symbol `host`, where frame `frame` is showing, into symbol - `target`, keeping where it is on screen and when. `carry` is the matrix from - `host`'s coordinates to `target`'s, and `back` the time map from `target`'s - frames to `host`'s. - - THE ONE RULE, for space and time alike: the node's new map is its old one - under what it leaves — its parents here, and the way from here to there — so - the picture and the timing through it do not change. For space that is a - `:pinv`, Blender's parent-inverse; for time it is a new `:at` and `:rate`. Its - channels, keys and span are untouched, and its children keep their parent - pointers and come with it. `{:clip}` or `{:refused why}`." - [clip store host frame id target carry back] - (let [nodes (:nodes (symbol clip host)) - n (get nodes id) - moving (subtree nodes id) - ;; Its parents in this symbol, outermost first. - chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) - parent (when-let [p (:parent n)] - (let [r (symbol/resolver (symbol clip host) store pal/index-of nil - {:source-fps (:fps clip)})] - (r frame) - (some-> (symbol/world-of r p) js/Float64Array.from)))] - (cond - (= host target) {:refused "it is already there"} - (and (= :instance (:kind n)) (contains-symbol? clip (:of n) target)) - {:refused "a symbol cannot go inside itself"} - (some (fn [m] (or (:measured (get nodes m)) - (some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m)))))) - moving) - {:refused "generated parts stay with their take — move the instance that places it"} - (some (fn [[k m]] (and (:stencil m) - (not= (contains? moving k) (contains? moving (:stencil m))))) - nodes) - {:refused "a stencil and what it clips have to move together"} - (and (:parent n) (nil? parent)) - {:refused "its parent is not on screen at this frame"} - (some #(get-in % [:time :loop?]) chain) - {:refused "a looping parent is in the way"} - :else - (let [taken (:nodes (symbol clip target)) - ids (into {} (map (fn [m] [m (free-id #(contains? taken %) m)])) moving) - pinv (reduce #(node/mul! (node/mat) %1 %2) carry (keep identity [parent (node/pinv n)])) - ;; back · parents · own: target frames to the node's own. - time (reduce node/then-time back (concat (map node/time-of chain) - [(node/time-of n)])) - moved (for [m moving - :let [x (get nodes m)]] - (cond-> (-> x - (assoc :id (ids m)) - (update :parent #(get ids %))) - (:stencil x) (update :stencil ids) - (= m id) (-> (retime time) - (assoc :pinv (vec (array-seq pinv)) - :z (str "z" (js/Date.now) "-" (ids m))))))] - {:id (ids id) - :sid target - :clip (-> clip - (update-symbol host update :nodes #(apply dissoc % moving)) - (update-symbol target update :nodes (fnil into {}) - (map (juxt :id identity)) moved))})))) - -(defn move-node - "Move the node at row path `from` — its last id is the node, the rest the - instances down to where it lives — into the symbol placed by the instance at - row path `to`, or to the top of `open` when `to` is empty. Row paths start at - `open`, and `f` is its current frame, at which both have to be on screen. - `{:clip :sid :id}` — the symbol it landed in and its id there, renamed only if - that one was taken — or `{:refused why}`." - [clip store open from to f] - (let [here (inside clip store open (pop from) f) - there (inside clip store open to f) - a (time-down clip open (pop from)) - b (time-down clip open to) - inv (some-> there :matrix invert)] - (cond - (nil? (get-in clip [:symbols (:sid here) :nodes (peek from)])) - {:refused "nothing to move"} - (or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"} - (not (and a b)) {:refused "a looping instance is in the way"} - (nil? inv) {:refused "the target is scaled to nothing"} - :else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there) - (node/mul! (node/mat) inv (:matrix here)) - (node/then-time (node/invert-time b) a))))) - -(defn group - "Put the nodes at row paths `froms`, all side by side in one symbol, into a - NEW symbol `sid`, placed where they were by instance `uuid`. `{:clip}` or - `{:refused why}`. - - The new symbol starts where the earliest of them starts and ends where the - last one ends, so its instance's bar on the timeline covers exactly theirs. - Its instance sits at the identity, so nothing moves, and pivots about the - middle of what it now holds." - [clip store open froms sid uuid f] - (let [host-path (pop (first froms)) - {host :sid frame :frame} (inside clip store open host-path f) - nodes (:nodes (symbol clip host)) - whole [0 (frames clip host)] - spans (for [from froms - :let [n (get nodes (peek from))]] - (or (node/placed-span n) - (when (= :instance (:kind n)) - (node/placed-span (assoc n :span [0 (frames clip (:of n))]))) - whole)) - start (max 0 (apply min (map first spans))) - end (min (second whole) (apply max (map second spans)))] - (cond - (nil? host) {:refused "they have to be on screen at this frame"} - (not-every? #(= host-path (pop %)) froms) {:refused "only things side by side can be grouped"} - (some #(nil? (get nodes (peek %))) froms) {:refused "nothing to group"} - :else - (let [made (-> clip - (assoc-in [:symbols sid] {:id sid :name (name sid) - :frames (max 1 (js/Math.ceil (- end start))) - :nodes {}}) - (place-symbol store host sid (js/Math.floor start) uuid nil)) - moved (reduce (fn [acc from] - (let [r (transplant (:clip acc) store host frame (peek from) sid - (node/mat) - (node/invert-time - (node/time-of (get-in (:clip acc) [:symbols host :nodes uuid]))))] - (if (:refused r) (reduced r) r))) - {:clip made} froms)] - (cond-> moved - (:clip moved) (update :clip assoc-in - [:symbols host :nodes uuid :channels [:xform :anchor] :value] - (center (:clip moved) store sid))))))) - -(defn- transform-op - "Put a symbol's already resolved mark into its instance's parent space." - [op m path] - (let [at (fn [x y] [(+ (* (aget m 0) x) (* (aget m 2) y) (aget m 4)) - (+ (* (aget m 1) x) (* (aget m 3) y) (aget m 5))]) - scale (node/mean-scale m) - op (assoc op :node (conj path (:node op)))] - (case (:kind op) - :poly (let [out (js/Float64Array. (.-length (:pts op)))] - (dotimes [i (:n op)] - (let [[x y] (at (aget (:pts op) (* 2 i)) - (aget (:pts op) (inc (* 2 i))))] - (aset out (* 2 i) x) - (aset out (inc (* 2 i)) y))) - (assoc op :pts out)) - :disc (let [[x y] (at (:cx op) (:cy op))] - (assoc op :cx x :cy y :r (* scale (:r op)))) - :rect (let [[x y] (at (:cx op) (:cy op))] - (assoc op :cx x :cy y :size (* scale (:size op)))) - op))) - -(defn resolver - "Resolve symbol `sid` of a clip, including every symbol its instances place. - - Each instance owns its own symbol resolver, so two offsets never share a - channel cursor or point buffer. The returned ops must be drawn before the next - frame, as with symbol/resolver. - - Any symbol can be resolved and none is the default: the frame space is the - resolved symbol's own `:frames`, and nested instances inside it still resolve, - because this is the function that knows how to do that." - ([clip store palette sid] (resolver clip store palette sid nil)) - ([clip store palette sid {:keys [picture-fps] :as opts}] - (letfn [(build [sid chain pose-tracks] - (when (some #{sid} chain) - (throw (ex-info "symbol cycle" {:chain (conj chain sid)}))) - (let [sym (or (symbol clip sid) - (throw (ex-info "an instance names a missing symbol" {:symbol sid}))) - nodes (:nodes sym) - rank (symbol/draw-rank nodes (symbol/order nodes)) - ids (sort-by rank (keys nodes)) - own (symbol/resolver sym store palette pose-tracks - (assoc opts :source-fps (:fps clip))) - children (into {} - (for [[id n] nodes :when (= :instance (:kind n))] - [id (build (:of n) (conj chain sid) - (get-in n [:playback :tracks]))]))] - (fn [f] - (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) - 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))] - (if (and frame (<= 0 frame) (< frame length)) - (map #(transform-op % m [id]) ((get children id) frame)) - [])) - (when-let [op (get by-id id)] [op])))) - ids))))))] - (build sid [] nil)))) - (defn problems "Human-readable reasons this clip will not evaluate or save." [clip] diff --git a/frontend/src/arthur/domain/nest.cljs b/frontend/src/arthur/domain/nest.cljs new file mode 100644 index 0000000..a43b8ba --- /dev/null +++ b/frontend/src/arthur/domain/nest.cljs @@ -0,0 +1,259 @@ +(ns arthur.domain.nest + "How nested symbols relate, and moving things between them. + + A row path — the ids from the open symbol down through instances, as the + timeline names a row — says where something is. Walking one answers three + questions at once, which is why there is one walk: what frame is showing down + there, what matrix takes its coordinates up to the open symbol's, and what + time map takes the open symbol's frames down to its own. + + ONE NESTING, AS FAR AS A PERSON IS CONCERNED. Putting a node inside another + symbol is how things are grouped: the symbol is a shared timeline, and its + instance is the handle that moves, retimes and transforms everything in it + together. Parent pointers inside a symbol stay — the roto rig is built on them + — but they are not something the timeline hands out. + + A MOVE CHANGES NEITHER THE PICTURE NOR THE TIMING. Every node has the same two + maps into its parent — the matrix of its transform, and `node/time-of` — and a + move keeps a node's world maps and re-expresses them under the new parent: the + matrix becomes a `:pinv`, Blender's parent-inverse, and the time a new `:at` + and `:rate`. Its channels, keys and span are untouched." + (:require [arthur.domain.clip :as clip] + [arthur.domain.node :as node] + [arthur.domain.palette :as pal] + [arthur.domain.symbol :as symbol])) + +(defn- invert + "The inverse of a 2x3 affine, or nil when it has none — an instance scaled to + nothing has no inside to draw into." + [^js m] + (let [[a b c d e f] (array-seq m) + det (- (* a d) (* b c))] + (when-not (zero? det) + (js/Float64Array. #js [(/ d det) (/ (- b) det) (/ (- c) det) (/ a det) + (/ (- (* c f) (* d e)) det) (/ (- (* b e) (* a f)) det)])))) + +(defn- resolved + "Symbol `sid` of `clip`, resolved at `frame`: the resolver, which then answers + `symbol/world-of` and `symbol/frame-of` for that frame." + [clip store sid frame] + (let [r (symbol/resolver (clip/symbol clip sid) store pal/index-of nil + {:source-fps (:fps clip)})] + (r frame) + r)) + +(defn inside + "Walk row path `path` down from symbol `sid`, whose frame `f` is showing. + Returns `{:sid :frame :matrix :time}`: the symbol the last instance places, + the frame it is showing there, the matrix from its coordinates to `sid`'s, and + the time map from `sid`'s frames to its own — or nil when an instance on the + way is not on screen at that frame, where there is no inside to be in. + + The frame and the matrix come from RESOLVING each level, so they are the ones + the stage draws with, floors included. The time map is the affine part, floors + aside, and is nil through a looping instance, whose frames come round again + and do not map one to one." + [clip store sid path f] + (reduce (fn [{:keys [sid frame matrix time]} id] + (let [r (resolved clip store sid frame) + nodes (:nodes (clip/symbol clip sid)) + 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])] + (if (and m (number? local) inner (< -1 local (clip/frames clip inner))) + {:sid inner :frame (js/Math.floor local) + :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)))} + (reduced nil)))) + {:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}} + path)) + +(defn drawn-inside + "Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the + symbol `path` leads to, so a shape added there lands exactly where it was drawn. + `{:sid :frame :pts}`, or nil where `inside` finds nothing to be inside." + [clip store sid path f pts] + (when-let [{:keys [matrix] :as at} (inside clip store sid path f)] + (when-let [inv (invert matrix)] + (let [out (js/Float64Array. 2)] + (assoc (select-keys at [:sid :frame]) + :pts (into [] (mapcat (fn [[x y]] + (node/apply-pt! out 0 inv x y) + [(aget out 0) (aget out 1)])) + (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." + [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))))))) + +(defn- retime + "Node `n` with its own time map replaced by `m`, and nothing else touched: its + span and keys are in its own frames, which a move does not change." + [n {:keys [at rate]}] + (assoc n :time (merge (:time n) {:mode :map :at at :rate rate :offset 0}))) + +(defn- subtree + "`id` and every node whose parent chain reaches it." + [nodes id] + (into #{} (filter #(some #{id} (symbol/lineage nodes %))) (keys nodes))) + +(defn- transplant + "Move node `id` from symbol `host`, where frame `frame` is showing, into symbol + `target`, keeping where it is on screen and when. `carry` is the matrix from + `host`'s coordinates to `target`'s, and `back` the time map from `target`'s + frames to `host`'s. + + THE ONE RULE, for space and time alike: the node's new map is its old one + under what it leaves — its parents here, and the way from here to there — so + the picture and the timing through it do not change. For space that is a + `:pinv`, Blender's parent-inverse; for time it is a new `:at` and `:rate`. Its + channels, keys and span are untouched, and its children keep their parent + pointers and come with it. `{:clip}` or `{:refused why}`." + [clip store host frame id target carry back] + (let [nodes (:nodes (clip/symbol clip host)) + n (get nodes id) + moving (subtree nodes id) + ;; Its parents in this symbol, outermost first. + chain (map #(get nodes %) (reverse (rest (symbol/lineage nodes id)))) + parent (when-let [p (:parent n)] + (some-> (symbol/world-of (resolved clip store host frame) p) + js/Float64Array.from))] + (cond + (= host target) {:refused "it is already there"} + (and (= :instance (:kind n)) (clip/contains-symbol? clip (:of n) target)) + {:refused "a symbol cannot go inside itself"} + (some (fn [m] (or (:measured (get nodes m)) + (some #(or (:dense %) (:generated %)) (vals (:channels (get nodes m)))))) + moving) + {:refused "generated parts stay with their take — move the instance that places it"} + (some (fn [[k m]] (and (:stencil m) + (not= (contains? moving k) (contains? moving (:stencil m))))) + nodes) + {:refused "a stencil and what it clips have to move together"} + (and (:parent n) (nil? parent)) + {:refused "its parent is not on screen at this frame"} + (some #(get-in % [:time :loop?]) chain) + {:refused "a looping parent is in the way"} + :else + (let [taken (:nodes (clip/symbol clip target)) + ids (into {} (map (fn [m] [m (clip/free-id #(contains? taken %) m)])) moving) + pinv (reduce #(node/mul! (node/mat) %1 %2) carry (keep identity [parent (node/pinv n)])) + ;; back · parents · own: target frames to the node's own. + time (reduce node/then-time back (concat (map node/time-of chain) + [(node/time-of n)])) + moved (for [m moving + :let [x (get nodes m)]] + (cond-> (-> x + (assoc :id (ids m)) + (update :parent #(get ids %))) + (:stencil x) (update :stencil ids) + (= m id) (-> (retime time) + (assoc :pinv (vec (array-seq pinv)) + :z (str "z" (js/Date.now) "-" (ids m))))))] + {:id (ids id) + :sid target + :clip (-> clip + (clip/update-symbol host update :nodes #(apply dissoc % moving)) + (clip/update-symbol target update :nodes (fnil into {}) + (map (juxt :id identity)) moved))})))) + +(defn move-node + "Move the node at row path `from` — its last id is the node, the rest the + instances down to where it lives — into the symbol placed by the instance at + row path `to`, or to the top of `open` when `to` is empty. Row paths start at + `open`, and `f` is its current frame, at which both have to be on screen. + `{:clip :sid :id}` — the symbol it landed in and its id there, renamed only if + that one was taken — or `{:refused why}`." + [clip store open from to f] + (let [here (inside clip store open (pop from) f) + there (inside clip store open to f) + a (:time here) + b (:time there) + inv (some-> there :matrix invert)] + (cond + (nil? (get-in clip [:symbols (:sid here) :nodes (peek from)])) + {:refused "nothing to move"} + (or (nil? here) (nil? there)) {:refused "both have to be on screen at this frame"} + (not (and a b)) {:refused "a looping instance is in the way"} + (nil? inv) {:refused "the target is scaled to nothing"} + :else (transplant clip store (:sid here) (:frame here) (peek from) (:sid there) + (node/mul! (node/mat) inv (:matrix here)) + (node/then-time (node/invert-time b) a))))) + +(defn group + "Put the nodes at row paths `froms`, all side by side in one symbol, into a + NEW symbol `sid`, placed where they were by instance `uuid`. `{:clip}` or + `{:refused why}`. + + The new symbol starts where the earliest of them starts and ends where the + last one ends, so its instance's bar on the timeline covers exactly theirs. + Its instance sits at the identity, so nothing moves, and pivots about the + middle of what it now holds." + [clip store open froms sid uuid f] + (let [host-path (pop (first froms)) + {host :sid frame :frame} (inside clip store open host-path f) + nodes (:nodes (clip/symbol clip host))] + (cond + (nil? host) {:refused "they have to be on screen at this frame"} + (not-every? #(= host-path (pop %)) froms) {:refused "only things side by side can be grouped"} + (some #(nil? (get nodes (peek %))) froms) {:refused "nothing to group"} + :else + (let [whole [0 (clip/frames clip host)] + spans (for [from froms + :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))]))) + whole)) + start (js/Math.floor (max 0 (apply min (map first spans)))) + end (min (second whole) (apply max (map second spans))) + made (-> clip + (assoc-in [:symbols sid] {:id sid :name (name sid) + :frames (max 1 (js/Math.ceil (- end start))) + :nodes {}}) + (clip/place-symbol store host sid start uuid nil)) + back (node/invert-time (node/time-of (get-in made [:symbols host :nodes uuid]))) + moved (reduce (fn [acc from] + (let [r (transplant (:clip acc) store host frame (peek from) sid + (node/mat) back)] + (if (:refused r) (reduced r) r))) + {:clip made} froms)] + (cond-> moved + (:clip moved) (update :clip assoc-in + [:symbols host :nodes uuid :channels [:xform :anchor] :value] + (clip/center (:clip moved) store sid))))))) diff --git a/frontend/src/arthur/events/footage.cljs b/frontend/src/arthur/events/footage.cljs index 4e7e531..27213d2 100644 --- a/frontend/src/arthur/events/footage.cljs +++ b/frontend/src/arthur/events/footage.cljs @@ -4,7 +4,7 @@ The frames come from the server by URL since step 9 — see `flow/ingest` — and the detector's identity comes from the server too, because it goes into the content address of every block this produces." - (:require [arthur.domain.clip :as clip] + (:require [arthur.domain.bring :as bring] [arthur.events.edit :as edit] [arthur.events.playback :as pb] [arthur.flow.detect :as detect] @@ -430,16 +430,13 @@ (let [uuid (random-uuid) fps (get-in db [:clip :fps]) {:keys [clip sid tracked?]} - (clip/add-take (:clip (store/entry (:clip/current db))) (:clip built) - name footage-id range) + (bring/take (:clip (store/entry (:clip/current db))) (:clip built) + name footage-id range) db (edit/edit-entry db - #(let [st (merge (:store %) (:store built))] - (cond-> (assoc % - :store st - :clip (clip/place-symbol clip st host sid frame uuid point)) - tracked? (merge (select-keys built [:footage-id :source-blocks - :source-inputs])))))] + #(cond-> (bring/placed % clip (:store built) sid host frame uuid point) + tracked? (merge (select-keys built [:footage-id :source-blocks + :source-inputs]))))] {:db (-> db (update :ui dissoc :convert) (assoc-in [:ui :selection] [:node host uuid [uuid]]) diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index 8429215..ecfcb05 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -22,6 +22,7 @@ Nothing here touches app-db except through events. The promise chain lives in an fx, which is the only thing in this namespace that is not pure." (:require [arthur.db :as db] + [arthur.domain.bring :as bring] [arthur.domain.clip :as clip] [arthur.domain.leaf :as leaf] [arthur.events.edit :as edit] @@ -153,20 +154,15 @@ (rf/reg-event-fx ::imported - ;; Copied, not linked: the symbol and everything it places come in under ids of - ;; their own, with the blocks they name, and editing them here does not touch - ;; the project they came from. They come in as DRAWINGS — their tracking stays - ;; with the analysis that measured them — so they play but do not re-tune. + ;; As drawing: its tracking stays with the analysis that measured it. See + ;; `arthur.domain.bring`. (fn [{:keys [db]} [_ {:keys [symbol host frame point label]} other]] (let [sid (leaf/unsegment symbol) uuid (random-uuid) - {:keys [clip ids]} (clip/adopt (:clip (store/entry (:clip/current db))) - (:clip other) [sid] {}) - db (edit/edit-entry - db - #(let [st (merge (:store %) (:store other))] - (assoc % :store st - :clip (clip/place-symbol clip st host (ids sid) frame uuid point))))] + {:keys [clip ids]} (bring/symbols (:clip (store/entry (:clip/current db))) + (:clip other) [sid] {}) + db (edit/edit-entry db #(bring/placed % clip (:store other) (ids sid) + host frame uuid point))] {:db (-> db (assoc-in [:ui :selection] [:node host uuid [uuid]]) (update :project merge {:status (str "brought in " label)})) diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 6ba9b76..f1b3865 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -6,6 +6,7 @@ there should not be one: an editor's own state is the cheapest thing in the app to change and the most expensive to have two copies of." (:require [arthur.domain.clip :as clip] + [arthur.domain.nest :as nest] [arthur.events.edit :as edit] [arthur.events.paint :as paint] [arthur.footage.store :as store] @@ -75,7 +76,7 @@ ;; Drawn on the stage, stored where it goes: inside the selected ;; instance, re-expressed in that symbol's coordinates and frame so it ;; lands exactly where it was drawn. - {:keys [sid frame pts]} (clip/drawn-inside clip st open down + {:keys [sid frame pts]} (nest/drawn-inside clip st open down (get-in db [:playback :frame]) draft)] (cond (< (count draft) 6) {} @@ -107,7 +108,7 @@ (fn [db _] (let [{clip :clip st :store} (store/entry (:clip/current db)) down (where-new-goes clip db) - {host :sid frame :frame} (clip/inside clip st (get-in db [:ui :open]) down + {host :sid frame :frame} (nest/inside clip st (get-in db [:ui :open]) down (get-in db [:playback :frame])) sid (clip/fresh-id clip) uuid (random-uuid)] @@ -155,7 +156,7 @@ ;; --------------------------------------------------------------------------- ;; moving rows between symbols ;; -;; Both are `clip/move-node` and `clip/group`, which keep the picture and the +;; Both are `nest/move-node` and `nest/group`, which keep the picture and the ;; timing as they are; what these add is where the selection goes and the reason ;; when a move is refused, which is the only feedback a refused drop has. @@ -166,7 +167,7 @@ ::move-node (fn [db [_ from to]] (let [{clip :clip st :store} (store/entry (:clip/current db)) - r (clip/move-node clip st (get-in db [:ui :open]) from to + r (nest/move-node clip st (get-in db [:ui :open]) from to (get-in db [:playback :frame]))] (if-let [why (:refused r)] (refused db why) @@ -183,11 +184,11 @@ f (get-in db [:playback :frame]) host (pop (first froms)) uuid (random-uuid) - r (clip/group clip st open froms (clip/fresh-id clip) uuid f)] + r (nest/group clip st open froms (clip/fresh-id clip) uuid f)] (if-let [why (:refused r)] (refused db why) (-> db (edit/edit (constantly (:clip r))) - (assoc-in [:ui :selection] [:node (:sid (clip/inside clip st open host f)) + (assoc-in [:ui :selection] [:node (:sid (nest/inside clip st open host f)) uuid (conj host uuid)]) (update-in [:ui :expanded] conj (conj host uuid))))))) diff --git a/frontend/test/arthur/domain/bring_test.cljs b/frontend/test/arthur/domain/bring_test.cljs new file mode 100644 index 0000000..3484228 --- /dev/null +++ b/frontend/test/arthur/domain/bring_test.cljs @@ -0,0 +1,26 @@ +(ns arthur.domain.bring-test + (:require [cljs.test :refer [deftest is]] + [arthur.domain.bring :as bring] + [arthur.domain.clip :as clip])) + +(defn- nested + "Three symbols: :outer places :inner, and :loose is placed by nothing." + [] + (-> (clip/blank) + (assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}}) + (assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}}) + (assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}}) + (clip/place-symbol nil :outer :inner 5 (random-uuid) nil))) + +(deftest adopting-symbols-renames-what-collides + (let [here (nested) + there (-> (clip/blank) + (assoc-in [:symbols :inner] {:id :inner :frames 4 :nodes {}}) + (clip/place-symbol nil :main :inner 0 #uuid "00000000-0000-4000-8000-0000000000aa" nil)) + {:keys [clip ids]} (bring/symbols here there [:main] {:main :take})] + (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]))))) + "and the copy's instance follows its renamed symbol") + (is (empty? (clip/problems clip))))) diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 5e652de..fd293c1 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -265,68 +265,6 @@ (is (seq (node/problems (assoc-in n [:time :in] 3))) "a stale :in is reported rather than silently ignored"))) -(deftest a-frame-is-carried-down-through-the-instances-a-row-path-names - (let [c (nested) - [id] (keys (get-in c [:symbols :outer :nodes])) - at #(select-keys (clip/inside c nil :outer %1 %2) [:sid :frame])] - (is (= {:sid :outer :frame 12} (at [] 12))) - (is (= {:sid :inner :frame 7} (at [id] 12)) - "the instance starts at 5, so frame 12 outside is frame 7 inside") - (is (nil? (clip/inside c nil :outer [id] 2)) - "and before it starts there is no inside to be in"))) - -(deftest a-shape-drawn-into-an-instance-lands-where-it-was-drawn - (let [u #uuid "00000000-0000-4000-8000-0000000000dd" - c (-> (clip/blank) - (assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}}) - (clip/place-symbol nil :main :box 10 u nil) - ;; moved, turned and doubled, so nothing lines up by accident - (update-in [:symbols :main :nodes u :channels] merge - {[:xform :pos] (ch/framed [40 20]) - [:xform :rot] (ch/framed (/ js/Math.PI 2)) - [:xform :scale] (ch/framed [2 2])})) - drawn [100 50 140 50 120 90] - {:keys [sid frame pts]} (clip/drawn-inside c nil :main [u] 16 drawn) - c (paint/new-shape c sid :shape frame pts :brow) - [op] (filter #(= [u :shape] (:node %)) - ((clip/resolver c nil pal/index-of :main) 16))] - (is (= :box sid)) - (is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10") - (is (every? #(< (js/Math.abs %) 1e-9) - (map - drawn (take 6 (array-seq (:pts op))))) - "resolved back out through the instance, it is exactly what was drawn"))) - -(deftest adopting-symbols-renames-what-collides - (let [here (nested) - there (-> (clip/blank) - (assoc-in [:symbols :inner] {:id :inner :frames 4 :nodes {}}) - (clip/place-symbol nil :main :inner 0 #uuid "00000000-0000-4000-8000-0000000000aa" nil)) - {:keys [clip ids]} (clip/adopt here there [:main] {:main :take})] - (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]))))) - "and the copy's instance follows its renamed symbol") - (is (empty? (clip/problems clip))))) - -(deftest a-placed-symbols-sound-is-heard-where-it-is-placed - (let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1" - :span [10 40] :time {:mode :map :at -10 :rate 1} - :channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}} - c (-> (clip/blank) - (assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}}) - (clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil)) - [t] (clip/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") - (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] (clip/audio-tracks c :main)] - (is (= [10 22] (:span t))) - (is (= [50 62] (node/placed-span t))))))) - (deftest an-instance-pivots-about-the-middle-of-what-it-draws (let [square (fn [x y] {:kind :poly :z "a1" :id :sq :channels {[:geom :pts] (ch/framed [x y (+ x 10) y (+ x 10) (+ y 10) x (+ y 10)]) @@ -351,95 +289,3 @@ (is (= [55 35] (clip/center grown nil :box)) "the symbol's middle moved") (is (= [25 35] (get-in grown [:symbols :main :nodes u :channels [:xform :anchor] :value])) "the instance's did not"))))) - -(defn- picture - "What `sid` draws at each of `fs`, without the node paths a move changes: - per frame, the sorted marks with their points rounded to a thousandth." - [c sid fs] - (let [resolve (clip/resolver c nil pal/index-of sid) - round #(/ (js/Math.round (* 1000 %)) 1000)] - (mapv (fn [f] - (sort-by str (map (fn [op] - [(:color op) (mapv round (take (* 2 (:n op)) (array-seq (:pts op))))]) - (resolve f)))) - fs))) - -(def ^:private a-uuid #uuid "00000000-0000-4000-8000-0000000000e1") -(def ^:private b-uuid #uuid "00000000-0000-4000-8000-0000000000e2") - -(defn- studio - "`main` holds a keyed shape and a moved, turned, doubled instance of `box`, - placed at frame 10; `box` holds a shape of its own." - [] - (let [tri (fn [id x keyed] - {:id id :kind :poly :z "a1" :paint? true :span [4 60] - :channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed)) - [:style :color] (ch/framed :brow)}})] - (-> (clip/blank) - (assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40})) - (assoc-in [:symbols :box] {:id :box :frames 50 :nodes {:inner (tri :inner 5 {0 10})}}) - (clip/place-symbol nil :main :box 10 a-uuid nil) - (update-in [:symbols :main :nodes a-uuid :channels] merge - {[:xform :pos] (ch/framed [30 20]) - [:xform :rot] (ch/framed 0.5) - [:xform :scale] (ch/framed [2 2])})))) - -(deftest moving-a-node-into-a-symbol-changes-nothing-on-screen - ;; From frame 10, where the instance starts: inside a symbol a node exists only - ;; while that symbol is on screen, so moving the shape in cuts off 4–9. - (let [c (studio) - fs [10 16 29 30 45 59 60 70] - {moved :clip :as r} (clip/move-node c nil :main [:tri] [a-uuid] 16)] - (is (nil? (:refused r)) (:refused r)) - (is (contains? (get-in moved [:symbols :box :nodes]) :tri) "it is in the symbol now") - (is (not (contains? (get-in moved [:symbols :main :nodes]) :tri)) "and not beside it") - (is (= [4 60] (get-in moved [:symbols :box :nodes :tri :span])) - "its span and keys are its own and do not change") - (is (= -10 (get-in moved [:symbols :box :nodes :tri :time :at])) - "its time map takes up the ten frames the instance starts late") - (is (= (picture c :main fs) (picture moved :main fs)) "and the picture is the same, frame for frame") - (testing "moving it back out is also invisible" - (let [{back :clip} (clip/move-node moved nil :main [a-uuid :tri] [] 16)] - (is (= (picture c :main fs) (picture back :main fs))))))) - -(deftest moving-an-instance-moves-only-its-at - (let [c (-> (studio) - (assoc-in [:symbols :holder] {:id :holder :frames 100 :nodes {}}) - (clip/place-symbol nil :main :holder 3 b-uuid nil)) - fs [0 10 16 40 59] - {moved :clip :as r} (clip/move-node c nil :main [a-uuid] [b-uuid] 16) - n (get-in moved [:symbols :holder :nodes a-uuid])] - (is (nil? (:refused r)) (:refused r)) - (is (= 7 (get-in n [:time :at])) "placed at 10 in main is at 7 inside something placed at 3") - (is (= [0 50] (:span n)) "its own frames do not move") - (is (= (picture c :main fs) (picture moved :main fs))))) - -(deftest grouping-makes-a-symbol-around-them-and-changes-nothing-on-screen - (let [c (studio) - fs [0 4 10 16 30 59 60] - {grouped :clip :as r} (clip/group c nil :main [[:tri] [a-uuid]] :group-1 b-uuid 16) - inst (get-in grouped [:symbols :main :nodes b-uuid])] - (is (nil? (:refused r)) (:refused r)) - (is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes]))))) - (is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were") - (is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts") - (is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends") - (is (= (picture c :main fs) (picture grouped :main fs))) - (is (empty? (clip/problems grouped))))) - -(deftest what-cannot-move-says-why - (let [c (studio)] - (is (:refused (clip/move-node c nil :main [a-uuid] [a-uuid] 16)) "not into itself") - (is (:refused (clip/move-node c nil :main [:tri] [a-uuid] 2)) "not while the target is off screen") - (let [roto (assoc-in c [:symbols :main :nodes :tri :channels [:geom :pts] :generated] {:by :roto})] - (is (re-find #"generated" (:refused (clip/move-node roto nil :main [:tri] [a-uuid] 16))))))) - -(deftest moving-into-a-retimed-instance-keeps-the-timing - (let [c (assoc-in (studio) [:symbols :main :nodes a-uuid :time :rate] 2) - fs [10 12 17 20 29 34] - {moved :clip :as r} (clip/move-node c nil :main [:tri] [a-uuid] 16)] - (is (nil? (:refused r)) (:refused r)) - (is (= {:at -20 :rate 0.5} - (select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate])) - "half speed inside something at double speed, so it runs as it did") - (is (= (picture c :main fs) (picture moved :main fs))))) diff --git a/frontend/test/arthur/domain/nest_test.cljs b/frontend/test/arthur/domain/nest_test.cljs new file mode 100644 index 0000000..a40f15d --- /dev/null +++ b/frontend/test/arthur/domain/nest_test.cljs @@ -0,0 +1,158 @@ +(ns arthur.domain.nest-test + (:require [cljs.test :refer [deftest is testing]] + [arthur.domain.channel :as ch] + [arthur.domain.clip :as clip] + [arthur.domain.nest :as nest] + [arthur.domain.node :as node] + [arthur.domain.paint :as paint] + [arthur.domain.palette :as pal])) + +(defn- nested + "Three symbols: :outer places :inner, and :loose is placed by nothing." + [] + (-> (clip/blank) + (assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}}) + (assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}}) + (assoc-in [:symbols :loose] {:id :loose :frames 30 :nodes {}}) + (clip/place-symbol nil :outer :inner 5 (random-uuid) nil))) + +(deftest a-frame-is-carried-down-through-the-instances-a-row-path-names + (let [c (nested) + [id] (keys (get-in c [:symbols :outer :nodes])) + at #(select-keys (nest/inside c nil :outer %1 %2) [:sid :frame])] + (is (= {:sid :outer :frame 12} (at [] 12))) + (is (= {:sid :inner :frame 7} (at [id] 12)) + "the instance starts at 5, so frame 12 outside is frame 7 inside") + (is (nil? (nest/inside c nil :outer [id] 2)) + "and before it starts there is no inside to be in"))) + +(deftest a-shape-drawn-into-an-instance-lands-where-it-was-drawn + (let [u #uuid "00000000-0000-4000-8000-0000000000dd" + c (-> (clip/blank) + (assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}}) + (clip/place-symbol nil :main :box 10 u nil) + ;; moved, turned and doubled, so nothing lines up by accident + (update-in [:symbols :main :nodes u :channels] merge + {[:xform :pos] (ch/framed [40 20]) + [:xform :rot] (ch/framed (/ js/Math.PI 2)) + [:xform :scale] (ch/framed [2 2])})) + drawn [100 50 140 50 120 90] + {:keys [sid frame pts]} (nest/drawn-inside c nil :main [u] 16 drawn) + c (paint/new-shape c sid :shape frame pts :brow) + [op] (filter #(= [u :shape] (:node %)) + ((clip/resolver c nil pal/index-of :main) 16))] + (is (= :box sid)) + (is (= 6 frame) "frame 16 of main is frame 6 of an instance placed at 10") + (is (every? #(< (js/Math.abs %) 1e-9) + (map - drawn (take 6 (array-seq (:pts op))))) + "resolved back out through the instance, it is exactly what was drawn"))) + +(deftest a-placed-symbols-sound-is-heard-where-it-is-placed + (let [voice {:id :v :kind :audio :source {:footage "f"} :z "a1" + :span [10 40] :time {:mode :map :at -10 :rate 1} + :channels {[:audio :gain] (ch/keyed {0 0.0 5 1.0})}} + c (-> (clip/blank) + (assoc-in [:symbols :talk] {:id :talk :frames 30 :nodes {:v voice}}) + (clip/place-symbol nil :main :talk 50 #uuid "00000000-0000-4000-8000-0000000000bb" nil)) + [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") + (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)] + (is (= [10 22] (:span t))) + (is (= [50 62] (node/placed-span t))))))) + +(defn- picture + "What `sid` draws at each of `fs`, without the node paths a move changes: + per frame, the sorted marks with their points rounded to a thousandth." + [c sid fs] + (let [resolve (clip/resolver c nil pal/index-of sid) + round #(/ (js/Math.round (* 1000 %)) 1000)] + (mapv (fn [f] + (sort-by str (map (fn [op] + [(:color op) (mapv round (take (* 2 (:n op)) (array-seq (:pts op))))]) + (resolve f)))) + fs))) + +(def ^:private a-uuid #uuid "00000000-0000-4000-8000-0000000000e1") +(def ^:private b-uuid #uuid "00000000-0000-4000-8000-0000000000e2") + +(defn- studio + "`main` holds a keyed shape and a moved, turned, doubled instance of `box`, + placed at frame 10; `box` holds a shape of its own." + [] + (let [tri (fn [id x keyed] + {:id id :kind :poly :z "a1" :paint? true :span [4 60] + :channels {[:geom :pts] (ch/keyed (into {} (map (fn [[f dx]] [f [x 10 (+ x dx) 10 x 40]])) keyed)) + [:style :color] (ch/framed :brow)}})] + (-> (clip/blank) + (assoc-in [:symbols :main :nodes :tri] (tri :tri 100 {4 20 30 40})) + (assoc-in [:symbols :box] {:id :box :frames 50 :nodes {:inner (tri :inner 5 {0 10})}}) + (clip/place-symbol nil :main :box 10 a-uuid nil) + (update-in [:symbols :main :nodes a-uuid :channels] merge + {[:xform :pos] (ch/framed [30 20]) + [:xform :rot] (ch/framed 0.5) + [:xform :scale] (ch/framed [2 2])})))) + +(deftest moving-a-node-into-a-symbol-changes-nothing-on-screen + ;; From frame 10, where the instance starts: inside a symbol a node exists only + ;; while that symbol is on screen, so moving the shape in cuts off 4–9. + (let [c (studio) + fs [10 16 29 30 45 59 60 70] + {moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)] + (is (nil? (:refused r)) (:refused r)) + (is (contains? (get-in moved [:symbols :box :nodes]) :tri) "it is in the symbol now") + (is (not (contains? (get-in moved [:symbols :main :nodes]) :tri)) "and not beside it") + (is (= [4 60] (get-in moved [:symbols :box :nodes :tri :span])) + "its span and keys are its own and do not change") + (is (= -10 (get-in moved [:symbols :box :nodes :tri :time :at])) + "its time map takes up the ten frames the instance starts late") + (is (= (picture c :main fs) (picture moved :main fs)) "and the picture is the same, frame for frame") + (testing "moving it back out is also invisible" + (let [{back :clip} (nest/move-node moved nil :main [a-uuid :tri] [] 16)] + (is (= (picture c :main fs) (picture back :main fs))))))) + +(deftest moving-an-instance-moves-only-its-at + (let [c (-> (studio) + (assoc-in [:symbols :holder] {:id :holder :frames 100 :nodes {}}) + (clip/place-symbol nil :main :holder 3 b-uuid nil)) + fs [0 10 16 40 59] + {moved :clip :as r} (nest/move-node c nil :main [a-uuid] [b-uuid] 16) + n (get-in moved [:symbols :holder :nodes a-uuid])] + (is (nil? (:refused r)) (:refused r)) + (is (= 7 (get-in n [:time :at])) "placed at 10 in main is at 7 inside something placed at 3") + (is (= [0 50] (:span n)) "its own frames do not move") + (is (= (picture c :main fs) (picture moved :main fs))))) + +(deftest grouping-makes-a-symbol-around-them-and-changes-nothing-on-screen + (let [c (studio) + fs [0 4 10 16 30 59 60] + {grouped :clip :as r} (nest/group c nil :main [[:tri] [a-uuid]] :group-1 b-uuid 16) + inst (get-in grouped [:symbols :main :nodes b-uuid])] + (is (nil? (:refused r)) (:refused r)) + (is (= #{:tri a-uuid} (set (keys (get-in grouped [:symbols :group-1 :nodes]))))) + (is (= [b-uuid] (keys (get-in grouped [:symbols :main :nodes]))) "one instance where they were") + (is (= 4 (get-in inst [:time :at])) "starting where the earliest of them starts") + (is (= 56 (clip/frames grouped :group-1)) "and lasting until the last one ends") + (is (= (picture c :main fs) (picture grouped :main fs))) + (is (empty? (clip/problems grouped))))) + +(deftest what-cannot-move-says-why + (let [c (studio)] + (is (:refused (nest/move-node c nil :main [a-uuid] [a-uuid] 16)) "not into itself") + (is (:refused (nest/move-node c nil :main [:tri] [a-uuid] 2)) "not while the target is off screen") + (let [roto (assoc-in c [:symbols :main :nodes :tri :channels [:geom :pts] :generated] {:by :roto})] + (is (re-find #"generated" (:refused (nest/move-node roto nil :main [:tri] [a-uuid] 16))))))) + +(deftest moving-into-a-retimed-instance-keeps-the-timing + (let [c (assoc-in (studio) [:symbols :main :nodes a-uuid :time :rate] 2) + fs [10 12 17 20 29 34] + {moved :clip :as r} (nest/move-node c nil :main [:tri] [a-uuid] 16)] + (is (nil? (:refused r)) (:refused r)) + (is (= {:at -20 :rate 0.5} + (select-keys (get-in moved [:symbols :box :nodes :tri :time]) [:at :rate])) + "half speed inside something at double speed, so it runs as it did") + (is (= (picture c :main fs) (picture moved :main fs)))))