diff --git a/frontend/src/arthur/db.cljs b/frontend/src/arthur/db.cljs index c83fff4..8fe4358 100644 --- a/frontend/src/arthur/db.cljs +++ b/frontend/src/arthur/db.cljs @@ -162,6 +162,7 @@ :time-view :timeline :tone :skin-base :tool nil + :auto-key? false :draft [] :knobs {} :trace {:faces #{} :opacity trace/opacity-default} diff --git a/frontend/src/arthur/domain/gesture.cljs b/frontend/src/arthur/domain/gesture.cljs index ec27248..7da71bd 100644 --- a/frontend/src/arthur/domain/gesture.cljs +++ b/frontend/src/arthur/domain/gesture.cljs @@ -7,10 +7,10 @@ is in the placement's matrices, so a shape five symbols down moves under the pointer like one on top. - THE KEYING RULE IS `node/set-channel`, the inspector's: a channel with keys - gets one on the node's own frame, and one without has its one value changed. - After Effects' stopwatch — there is no mode to be in, and nothing snaps back - on the next frame as an unkeyed change does in Blender." + The normal keying rule is `node/set-channel`, the inspector's: a channel with + keys gets one on the node's own frame, and one without has its one value + changed. Auto-key deliberately replaces that rule with `set-keyed-channel`, + so touching an otherwise static transform starts its animation at this frame." (:require [arthur.domain.channel :as ch] [arthur.domain.node :as node])) @@ -78,7 +78,22 @@ (defn apply-values "Clip with channel values `vs`, `{path value}`, written into node `id` of - symbol `sid` on the node's own frame `f`, by the keying rule above." - [clip sid id f vs] - (update-in clip [:symbols sid :nodes id] - #(reduce-kv (fn [n path v] (node/set-channel n path f v)) % vs))) + symbol `sid` on the node's own frame `f`, by the keying rule above. The sixth + argument arms auto-key; the five-argument form retains the normal rule." + ([clip sid id f vs] (apply-values clip sid id f vs false)) + ([clip sid id f vs auto-key?] + (let [put (if auto-key? node/set-keyed-channel node/set-channel)] + (update-in clip [:symbols sid :nodes id] + #(reduce-kv (fn [n path v] (put n path f v)) % vs))))) + +(defn apply-take + "Apply a buffered performance take. `take` is keyed by `[symbol node]`, then + local frame, then channel path. It becomes ordinary authored keys in one + document edit rather than making the edit pipeline run for every sample." + [clip take] + (reduce-kv + (fn [c [sid id] frames] + (reduce-kv (fn [c f values] + (apply-values c sid id f values true)) + c frames)) + clip take)) diff --git a/frontend/src/arthur/domain/lane.cljs b/frontend/src/arthur/domain/lane.cljs index 5a1337a..3c5c743 100644 --- a/frontend/src/arthur/domain/lane.cljs +++ b/frontend/src/arthur/domain/lane.cljs @@ -1,11 +1,19 @@ (ns arthur.domain.lane - "The commands over a lane of cels: make one, put drawings in it, change - how long they are exposed, and decide which of them share content. + "The commands that need a SEQUENCE: make a lane, put drawings in it, change + how long they are exposed, empty part of it, and decide which cels share + content. WHAT A LANE IS lives in `arthur.domain.symbol`, beside the other rules about a node map: a group with `:layout :sequence`, whose children are non-overlapping visual cels. This namespace only changes them. + WHAT IS NOT HERE: split, trim and move. Each of those is one write to one + node's span or position, which is a fact every node has, so they live in + `arthur.domain.span` and work on a symbol placed straight into a shot as + readily as on a cel. What stays here is everything that cannot be said about + one node alone — a ripple needs later siblings, a gap needs a row to be a hole + in, and appending needs to know where the row stops. + EVERY COMMAND IS ONE STEP AND ALL OF IT. Each returns `{:clip :selection}` or `{:refused reason}` — never a half-applied edit, and never a document that `clip/problems` would reject. A command that cannot say what the person meant @@ -20,76 +28,9 @@ (:require [arthur.domain.bring :as bring] [arthur.domain.clip :as clip] [arthur.domain.node :as node] + [arthur.domain.span :as span] [arthur.domain.symbol :as symbol])) -(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)) - (<= (or (:expose t) 1) 1)) - (recur (:parent n) (conj seen id) (conj chain n))))))) - -(defn- finish - "Commit `nodes` as symbol `sid`'s, or refuse. - - THE SHOT LENGTH IS AUTHORED. `:frames` is the symbol's window — how long the - shot IS — and the occupied extent of its lanes is a different fact derived - from the cels. A command may GROW the window when the caller says - `:grow-symbol`, and never shrinks it: emptying the end of a shot leaves a shot - with empty frames at the end, which is a true statement about what somebody - authored. Deriving the window from the extent instead would make deleting the - last drawing silently shorten the film. - - So there are two numbers and this function keeps them apart: `needed` is where - the cels reach, `:frames` is what was authored, and the only way the - second follows the first is a caller asking." - [clip sid nodes selection extent] - (let [sym (clip/symbol clip sid) - reach (for [[id n] nodes :when (node/lane? n) - child (symbol/lane-cels nodes id) - :let [m (lane-map nodes id) - end (second (node/placed-span child))]] - (when m (+ (:at m) (/ end (:rate m))))) - needed (js/Math.ceil (apply max 0 (keep identity reach))) - ps (symbol/problems (assoc sym :nodes nodes))] - (cond - (seq ps) {:refused (first ps)} - (not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"} - (and (> needed (:frames sym)) (= :keep extent)) - {:refused (str "the edit needs " needed " frames; extend the shot to continue") - :required-frames needed} - :else {:clip (cond-> (assoc-in clip [:symbols sid :nodes] nodes) - (> needed (:frames sym)) - (assoc-in [:symbols sid :frames] needed)) - :selection selection}))) - -;; --------------------------------------------------------------------------- -;; the geometry every cel edit is made of -;; -;; A `:span` is in the cel's OWN frames and its `:time` says where those -;; land in the lane. So moving an edge of a cel is one write to `:span`, -;; and `:time` and `:playback` are untouched — which is why trimming the front -;; of a playing insert starts it later in its source instead of resetting it, -;; and why the two halves of a split go on meaning what the one cel meant. -;; Trim, split and blank are all this one operation, applied differently. - -(defn- local - "Lane frame `f` as one of `n`'s own frames." - [n f] - (let [{:keys [at rate]} (node/time-of n)] - (* rate (- f at)))) - -(defn- edged - "`n` with its `:in` or `:out` edge at lane frame `f`." - [n which f] - (assoc-in n [:span (case which :in 0 :out 1)] (local n f))) - (defn extend-hold "Change one held cel's duration by `delta` lane frames and ripple its later siblings. Lane channels, cel channels and source clocks stay put. @@ -100,7 +41,7 @@ lane (get nodes (:parent n)) rate (:rate (node/time-of n)) span (:span n) - m (when lane (lane-map nodes (:id lane))) + m (when lane (symbol/frame-map nodes (:id lane))) ;; The LANE's own shape, not the whole symbol's: refusing a cel ;; edit over some unrelated defect elsewhere in the symbol would be ;; this command answering for a part of the document it never touches. @@ -120,90 +61,7 @@ nodes (reduce (fn [ns sibling] (update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) nodes later)] - (finish clip sid nodes id extent))))) - -(defn split - "Cut cel `id` in two at lane frame `cut`. The left piece keeps its - identity; the right gets `new-id`. - - NOTHING BUT `:span` DIFFERS between the two pieces. They keep one `:time`, so - the right piece's own frames carry on exactly where the left's stopped, and its - source clock, its keys and its corrections therefore go on meaning what they - meant before the cut — preserved by construction rather than by arithmetic on - in-points that could be wrong. A held drawing holds the same frame on both - sides; a playing insert plays on through the cut without a seam. That is what - `:span` being in the node's OWN coordinates buys, and it is why splitting - needs no shot-length policy: the pieces occupy the frames the one cel - occupied. - - The right piece is the selection, because it is the piece that was made." - [clip sid id cut new-id] - (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - lane (get nodes (:parent n)) - {:keys [at rate]} (node/time-of n) - [lo hi] (or (node/placed-span n) [nil nil])] - (cond - (not (node/lane? lane)) {:refused "select a cel in a lane"} - (not (integer? cut)) {:refused "a cut is a whole lane frame"} - (contains? nodes new-id) {:refused "the new cel ID is already used"} - (not (and lo (< lo cut hi))) - {:refused (str "frame " cut " is not inside this cel")} - :else - (let [nodes (-> nodes - (assoc id (edged n :out cut)) - (assoc new-id (assoc (edged n :in cut) - :id new-id :z (str "a-" new-id))))] - (finish clip sid nodes new-id :keep))))) - -(defn trim - "Move one edge of cel `id` to lane frame `to`, without disturbing a - single other cel. - - TRIM NARROWS. Lengthening a cel is `extend-hold`, which carries a ripple - policy and a shot-length policy because it needs them; letting trim grow as - well would give one gesture two sets of rules and a way to overlap its - neighbour. `edge` is `:in` or `:out`. - - The source clock is untouched, so trimming the front of a playing insert - starts it later INTO its animation rather than restarting it — which is the - difference between trimming and slipping, and why they are separate commands." - [clip sid id edge to] - (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - lane (get nodes (:parent n)) - [lo hi] (or (node/placed-span n) [nil nil])] - (cond - (not (node/lane? lane)) {:refused "select a cel in a lane"} - (not (#{:in :out} edge)) {:refused "an edge is :in or :out"} - (not (integer? to)) {:refused "an edge goes to a whole lane frame"} - (not (and lo (< lo to hi))) - {:refused (str "frame " to " is not inside this cel; trim narrows it")} - :else (finish clip sid (assoc nodes id (edged n edge to)) id :keep)))) - -(defn move - "Put cel `id` at lane frame `to`, leaving every other cel and - its own length, source and corrections alone. - - One write to `:time :at`. A destination that would overlap a neighbour is - REFUSED rather than rippled or overwritten: moving a drawing and re-timing the - ones around it are different intentions, and a move that silently pushed the - rest would be the second one wearing the first one's name. Clear the room - first — `blank` makes a gap, `trim` shortens a neighbour." - [clip sid id to] - (let [nodes (get-in clip [:symbols sid :nodes]) - n (get nodes id) - lane (get nodes (:parent n)) - {:keys [at]} (node/time-of n)] - (cond - (not (node/lane? lane)) {:refused "select a cel in a lane"} - (not (integer? to)) {:refused "a cel moves to a whole lane frame"} - (nil? (node/placed-span n)) {:refused "a cel needs a span to move"} - :else - (let [moved (update-in n [:time :at] (fnil + 0) (- to (first (node/placed-span n))))] - (if (not= to (first (node/placed-span moved))) - {:refused "cel timing through a stepped or looping lane is not supported"} - (finish clip sid (assoc nodes id moved) id :keep)))))) + (span/finish clip sid nodes id extent))))) (defn blank "Clear lane frames `[a b)` of lane `lane-id`, leaving a GAP. @@ -212,7 +70,7 @@ closes the hole — the cels after it stay where they are, because emptying frames and re-timing a performance are different intentions. - What it does to each cel it meets is the edge geometry above: one wholly + What it does to each cel it meets is `span/edged`, applied three ways: one wholly inside is removed, one overlapping an end is trimmed to it, and the one that spans the whole range is split, which is the only case that needs `id`. Their drawings stay in the library — a lane does not own its content, and a drawing @@ -238,13 +96,13 @@ (or (<= hi a) (>= lo b)) ns (and (< lo a) (> hi b)) (-> ns - (assoc (:id n) (edged n :out a)) - (assoc id (assoc (edged n :in b) :id id :z (str "a-" id)))) + (assoc (:id n) (span/edged n :out a)) + (assoc id (assoc (span/edged n :in b) :id id :z (str "a-" id)))) (and (>= lo a) (<= hi b)) (dissoc ns (:id n)) - (< lo a) (assoc ns (:id n) (edged n :out a)) - :else (assoc ns (:id n) (edged n :in b))))) + (< lo a) (assoc ns (:id n) (span/edged n :out a)) + :else (assoc ns (:id n) (span/edged n :in b))))) nodes members)] - (finish clip sid nodes (or (when spanning id) lane-id) :keep))))) + (span/finish clip sid nodes (or (when spanning id) lane-id) :keep))))) (defn sheet-range "Snapshot a rectangle in open-symbol frames. Cel-local clocks and channels @@ -253,7 +111,7 @@ (let [nodes (get-in clip [:symbols sid :nodes])] (if-not (and (seq lanes) (integer? a) (integer? b) (<= 0 a) (< a b) (every? #(and (node/lane? (get nodes %)) - (= {:at 0 :rate 1} (lane-map nodes %))) lanes)) + (= {:at 0 :rate 1} (symbol/frame-map nodes %))) lanes)) {:refused "range editing requires lanes with the same clock as the sheet"} {:duration (- b a) :columns @@ -262,8 +120,8 @@ :let [[lo hi] (node/placed-span n)] :when (and (< lo b) (> hi a))] (-> n - (edged :in (max a lo)) - (edged :out (min b hi)) + (span/edged :in (max a lo)) + (span/edged :out (min b hi)) (update-in [:time :at] (fnil - 0) a))))) lanes)}))) (defn paste-range @@ -292,7 +150,7 @@ (assoc :id cid :parent id :z (str "a-" cid)) (update-in [:time :at] + at))))) (get-in (:clip cleared) [:symbols sid :nodes]) cels) - result (finish (:clip cleared) sid nodes id :keep) + result (span/finish (:clip cleared) sid nodes id :keep) problems (when (:clip result) (clip/problems (:clip result)))] (if (seq problems) {:refused (first problems)} result)))))) {:clip clip :selection (first lanes)} @@ -326,7 +184,7 @@ stepped or looping lane, where one frame of the symbol is not one frame of the lane and there is no single answer to give a command." [clip sid lane-id f] - (when-let [{:keys [at rate]} (lane-map (get-in clip [:symbols sid :nodes]) lane-id)] + (when-let [{:keys [at rate]} (symbol/frame-map (get-in clip [:symbols sid :nodes]) lane-id)] (* rate (- f at)))) (defn- lane-end @@ -358,8 +216,8 @@ nodes (reduce (fn [ns sibling] (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) (assoc nodes id n) later) - result (finish clip sid nodes id extent) - m (lane-map nodes lane-id)] + result (span/finish clip sid nodes id extent) + m (symbol/frame-map nodes lane-id)] (cond-> result (:clip result) (assoc :frame (+ (:at m) (/ at (:rate m))))))) @@ -381,7 +239,7 @@ (not (or (= :end at) (and (integer? at) (not (neg? at))))) "a position is :end or a whole lane frame" inside (str "frame " at " is inside a cel; split it first") - (nil? (lane-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported" + (nil? (symbol/frame-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported" :else (first (symbol/lane-problems nodes))))) (defn append-drawing @@ -468,7 +326,7 @@ (or (= id remainder-id) (contains? nodes remainder-id)) "the remainder cel needs a free ID different from the new cel" (clip/symbol clip drawing-id) "the new drawing ID is already used" - (nil? (lane-map nodes lane-id)) + (nil? (symbol/frame-map nodes lane-id)) "drawing creation through a stepped or looping lane is not supported")] {:refused why} (let [cleared (blank clip sid lane-id [at (inc at)] {:id remainder-id})] diff --git a/frontend/src/arthur/domain/node.cljs b/frontend/src/arthur/domain/node.cljs index 77694ad..1d5a474 100644 --- a/frontend/src/arthur/domain/node.cljs +++ b/frontend/src/arthur/domain/node.cljs @@ -104,6 +104,17 @@ (assoc-in n [:channels path] (if (:keys c) (assoc-in c [:keys f] v) (ch/framed v))))) +(defn set-keyed-channel + "Write `v` as a key at `f`, starting an animated channel when needed. This is + the auto-key counterpart to `set-channel`; an existing channel keeps its + interpolation and segment choices." + [n path f v] + (let [c (get (channels n) path)] + (assoc-in n [:channels path] + (if (:keys c) + (assoc-in c [:keys f] v) + (ch/keyed {f v} (if (boolean? v) :hold :linear)))))) + (defn toggle-key "Key channel `path` on the node's own frame `f` with the value it has there, or take the key there off. The first key starts the channel animating and taking diff --git a/frontend/src/arthur/domain/span.cljs b/frontend/src/arthur/domain/span.cljs new file mode 100644 index 0000000..49bc43a --- /dev/null +++ b/frontend/src/arthur/domain/span.cljs @@ -0,0 +1,192 @@ +(ns arthur.domain.span + "The commands over ONE node's place in time: split it, trim an edge, move it. + + A `:span` is in the node's OWN frames and its `:time` says where those land in + its parent, and that is true of EVERY node — which is why these three are not + lane commands, though a lane of cels is where they were first needed. A cel in + a lane, a symbol placed straight into a shot, a shape that exists for part of + one: each is a span in a parent's frame space, and a span in a parent's frame + space is the whole of what these commands touch. They were gated on a lane for + as long as a lane was the only thing anybody had timed. + + THE COORDINATE IS ALWAYS THE PARENT'S. For a cel the parent is its lane, so + `host-frame` reads lane time exactly as the lane commands always did; for a + node sitting straight in the symbol it reads the symbol's own frames. One rule, + so a caller holding a node does not branch on what it sits in. + + A GROUP IS REFUSED. Dividing a group means deciding what becomes of its + children, and nothing in a span says: the right half of a split lane would + reference none of its cels, and a span that narrows past a child hides it + without saying so. `domain/lane` holds the commands for a sequence, which are + the ones that ripple siblings or leave a gap. + + `finish` lives here because every command in this namespace and every one in + `domain/lane` commits through it." + (:require [arthur.domain.clip :as clip] + [arthur.domain.node :as node] + [arthur.domain.symbol :as symbol])) + +(defn finish + "Commit `nodes` as symbol `sid`'s, or refuse. + + THE SHOT LENGTH IS AUTHORED. `:frames` is the symbol's window — how long the + shot IS — and the occupied extent of its lanes is a different fact derived + from the cels. A command may GROW the window when the caller says + `:grow-symbol`, and never shrinks it: emptying the end of a shot leaves a shot + with empty frames at the end, which is a true statement about what somebody + authored. Deriving the window from the extent instead would make deleting the + last drawing silently shorten the film. + + So there are two numbers and this function keeps them apart: `needed` is where + the cels reach, `:frames` is what was authored, and the only way the + second follows the first is a caller asking. + + Only LANES are measured for reach. A node placed straight in a shot may hang + off the end of it — that is an ordinary thing to author and the window is + what crops it — whereas a lane's cels are a sequence whose length is the + thing being edited." + [clip sid nodes selection extent] + (let [sym (clip/symbol clip sid) + reach (for [[id n] nodes :when (node/lane? n) + child (symbol/lane-cels nodes id) + :let [m (symbol/frame-map nodes id) + end (second (node/placed-span child))]] + (when m (+ (:at m) (/ end (:rate m))))) + needed (js/Math.ceil (apply max 0 (keep identity reach))) + ps (symbol/problems (assoc sym :nodes nodes))] + (cond + (seq ps) {:refused (first ps)} + (not (#{:keep :grow-symbol} extent)) {:refused "choose an explicit shot-length policy"} + (and (> needed (:frames sym)) (= :keep extent)) + {:refused (str "the edit needs " needed " frames; extend the shot to continue") + :required-frames needed} + :else {:clip (cond-> (assoc-in clip [:symbols sid :nodes] nodes) + (> needed (:frames sym)) + (assoc-in [:symbols sid :frames] needed)) + :selection selection}))) + +;; --------------------------------------------------------------------------- +;; the geometry every edge edit is made of +;; +;; A `:span` is in the node's OWN frames and its `:time` says where those +;; land in the parent. So moving an edge is one write to `:span`, and `:time` +;; and `:playback` are untouched — which is why trimming the front of a playing +;; insert starts it later in its source instead of resetting it, and why the two +;; halves of a split go on meaning what the one node meant. +;; Trim, split and `lane/blank` are all this one operation, applied differently. + +(defn local + "Parent frame `f` as one of `n`'s own frames." + [n f] + (let [{:keys [at rate]} (node/time-of n)] + (* rate (- f at)))) + +(defn edged + "`n` with its `:in` or `:out` edge at parent frame `f`." + [n which f] + (assoc-in n [:span (case which :in 0 :out 1)] (local n f))) + +(defn host-frame + "Symbol frame `f` as a frame of the space node `id` is POSITIONED in — its + parent's — which is the frame space every command here takes its coordinate + in. Nil through a stepped or looping ancestor, where one frame of the symbol + is not one frame of the parent and there is no single answer to give." + [clip sid id f] + (let [nodes (get-in clip [:symbols sid :nodes])] + (when-let [{:keys [at rate]} (symbol/frame-map nodes (:parent (get nodes id)))] + (* rate (- f at))))) + +(defn- subject + "The node `id` names, as `{:node n}`, or `{:refused why}` where these commands + have nothing to act on. The one guard all three share." + [nodes id] + (let [n (get nodes id)] + (cond + (nil? n) {:refused "select something with a place in time"} + (= :group (:kind n)) + {:refused "a group is divided by its children, not by its span"} + (nil? (node/placed-span n)) + {:refused "this is on screen for the whole shot, so it has no edges to cut"} + :else {:node n}))) + +(defn split + "Cut node `id` in two at parent frame `cut`. The left piece keeps its + identity; the right gets `new-id`. + + NOTHING BUT `:span` DIFFERS between the two pieces. They keep one `:time`, so + the right piece's own frames carry on exactly where the left's stopped, and its + source clock, its keys and its corrections therefore go on meaning what they + meant before the cut — preserved by construction rather than by arithmetic on + in-points that could be wrong. A held drawing holds the same frame on both + sides; a playing insert plays on through the cut without a seam; a shape goes + on being the same shape over each half. That is what `:span` being in the + node's OWN coordinates buys, and it is why splitting needs no shot-length + policy: the pieces occupy the frames the one node occupied. + + THE RIGHT PIECE KEEPS THE ORIGINAL'S `:z`. Two halves of one thing draw at + one depth; nothing orders them against each other, because they are never on + screen on the same frame. Cels in a lane do not consult `:z` at all — + `symbol/lane-cels` sorts them by where they start. + + The right piece is the selection, because it is the piece that was made." + [clip sid id cut new-id] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id) + [lo hi] (when node (node/placed-span node))] + (cond + refused {:refused refused} + (not (integer? cut)) {:refused "a cut is a whole frame"} + (contains? nodes new-id) {:refused "the new ID is already used"} + (not (< lo cut hi)) {:refused (str "frame " cut " is not inside this")} + :else + (let [nodes (-> nodes + (assoc id (edged node :out cut)) + (assoc new-id (assoc (edged node :in cut) :id new-id)))] + (finish clip sid nodes new-id :keep))))) + +(defn trim + "Move one edge of node `id` to parent frame `to`, without disturbing anything + else at all. + + TRIM NARROWS. Lengthening a cel is `lane/extend-hold`, which carries a ripple + policy and a shot-length policy because it needs them; letting trim grow as + well would give one gesture two sets of rules and a way to overlap its + neighbour. `edge` is `:in` or `:out`. + + The source clock is untouched, so trimming the front of a playing insert + starts it later INTO its animation rather than restarting it — which is the + difference between trimming and slipping, and why they are separate commands." + [clip sid id edge to] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id) + [lo hi] (when node (node/placed-span node))] + (cond + refused {:refused refused} + (not (#{:in :out} edge)) {:refused "an edge is :in or :out"} + (not (integer? to)) {:refused "an edge goes to a whole frame"} + (not (< lo to hi)) + {:refused (str "frame " to " is not inside this; trim narrows it")} + :else (finish clip sid (assoc nodes id (edged node edge to)) id :keep)))) + +(defn move + "Put node `id` at parent frame `to`, leaving its own length, source and + corrections alone — and, in a lane, every other cel. + + One write to `:time :at`. A destination that would overlap a neighbour IN A + LANE is refused rather than rippled or overwritten: moving a drawing and + re-timing the ones around it are different intentions, and a move that + silently pushed the rest would be the second one wearing the first one's name. + Clear the room first — `lane/blank` makes a gap, `trim` shortens a neighbour. + Outside a lane there is no such rule to break: things placed in a composition + are allowed to be on screen together, so the move simply happens." + [clip sid id to] + (let [nodes (get-in clip [:symbols sid :nodes]) + {:keys [node refused]} (subject nodes id)] + (cond + refused {:refused refused} + (not (integer? to)) {:refused "a move goes to a whole frame"} + :else + (let [moved (update-in node [:time :at] (fnil + 0) (- to (first (node/placed-span node))))] + (if (not= to (first (node/placed-span moved))) + {:refused "timing through a stepped or looping parent is not supported"} + (finish clip sid (assoc nodes id moved) id :keep)))))) diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index 6a66160..cda5d5d 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -102,6 +102,46 @@ (sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %)))) vec)) +(defn frame-map + "Node `id`'s own frames as a map from the containing symbol's, inverted: + `{:at a :rate r}`, meaning symbol frame `p` is frame `r·(p − a)` of `id`. + Identity for `nil`, which is a node sitting directly in the symbol. + + THE FRAME SPACE A COMMAND IS GIVEN ITS COORDINATE IN. A cel's parent is its + lane, so a lane command composing this for the lane reads lane time; a node + with no parent reads the symbol's own frames. One rule either way, so a caller + holding a node does not have to ask what it is sitting in. + + Refuses floors and loops rather than pretend an affine map preserves them: + through either, one frame of the symbol is not one frame of `id` and a command + handed a single frame has no single answer to give." + [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)) + (<= (or (:expose t) 1) 1)) + (recur (:parent n) (conj seen id) (conj chain n))))))) + +(defn lanes + "The symbol's lanes, front-most first. + + SAME ORDER THE TIMELINE DRAWS ITS ROWS IN — `:z` descending, the id breaking + ties so it is stable across runs — because the cel sheet's columns are those + rows stood on end, and \"the first lane\" has to mean the same thing to the view + that shows them and to the command that defaults to one. + + Only this symbol's own: a lane inside a nested instance belongs to that + symbol, and aiming a drawing at it is entering it first." + [nodes] + (->> (vals nodes) + (filter node/lane?) + (sort-by (fn [n] [(or (:z n) "") (str (:id n))])) + reverse + vec)) + (defn lane-problems "What makes a lane not a lane. A SEQUENCE is the one composition rule the node map carries — ordinary groups compose freely — so it is checked here, beside diff --git a/frontend/src/arthur/events/playback.cljs b/frontend/src/arthur/events/playback.cljs index a4794a1..c79e5e2 100644 --- a/frontend/src/arthur/events/playback.cljs +++ b/frontend/src/arthur/events/playback.cljs @@ -47,16 +47,18 @@ (assoc-in [:playback :frame] 0) (assoc-in [:playback :playing?] false)))) -(rf/reg-event-db +(rf/reg-event-fx ::tick - (fn [db [_ f]] + (fn [{:keys [db]} [_ f]] ;; Written from the rAF loop when the DERIVED frame changes — not every ;; animation frame, and never as the thing the blit waits on. The picture is ;; painted from the clock directly; this only brings the document's idea of ;; the playhead up to date so the readout and the scrubber agree with it. (if (= f (get-in db [:playback :frame])) - db - (assoc-in db [:playback :frame] f)))) + {:db db} + (cond-> {:db (assoc-in db [:playback :frame] f)} + (get-in db [:ui :gesture :auto-key?]) + (assoc :dispatch [:arthur.events.ui/record-gesture f]))))) (rf/reg-event-fx ::play diff --git a/frontend/src/arthur/events/project.cljs b/frontend/src/arthur/events/project.cljs index 3d33ada..ab6b630 100644 --- a/frontend/src/arthur/events/project.cljs +++ b/frontend/src/arthur/events/project.cljs @@ -635,7 +635,8 @@ ::set-channel ;; `frame` is the node's own, as for a drawing key. (fn [db [_ sid id path frame value]] - (edit/edit db #(update-in % [:symbols sid :nodes id] node/set-channel path frame value)))) + (let [put (if (get-in db [:ui :auto-key?]) node/set-keyed-channel node/set-channel)] + (edit/edit db #(update-in % [:symbols sid :nodes id] put path frame value))))) (rf/reg-event-db ::toggle-key diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 462b985..0658e0d 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -1,6 +1,19 @@ (ns arthur.events.ui - "Selection, the active tone, the polygon being drawn, and which timeline rows - are open. + "Selection, the TARGET, the active tone, the polygon being drawn, and which + timeline rows are open. + + TWO PIECES OF STATE AND NOT ONE. `[:ui :selection]` is what you are LOOKING + at — what the inspector shows, what the stage puts handles on. `[:ui :target]` + is where a new thing would GO. They used to be one, so clicking a shape on the + stage silently re-aimed the next polygon at whatever held it, which + `lane-model.md` forbids in so many words: \"Selection does not secretly change + where a new symbol goes.\" + + THE TARGET MOVES ONLY WHEN SOMEBODY AIMS IT. A click on a timeline row label, + a cel-sheet column, or a breadcrumb is aiming — each names a place in the + document and nothing else. A click on the stage, or on a timeline bar, is not: + it says look at this. So `::select` never writes the target, and `::aim` + always writes both. All of it is `assoc-in` under `:ui`. There is no effect in this namespace and there should not be one: an editor's own state is the cheapest thing in the @@ -11,38 +24,107 @@ [arthur.domain.nest :as nest] [arthur.domain.node :as node] [arthur.domain.lane :as lane] + [arthur.domain.span :as span] + [arthur.domain.symbol :as symbol] [arthur.events.edit :as edit] - [arthur.events.paint :as paint] + [arthur.domain.paint :as paint] [arthur.events.playback :as playback] [arthur.footage.store :as store] [re-frame.core :as rf])) +(defn selected + "`db` with `selection` selected, and nothing aimed. + + The rows above a selection are opened, so one made deep on the stage is seen + in the timeline. Not a sound's: its row is always in the audio section, and + opening the placement it is heard through would bury it." + [db selection] + (let [[kind sid id path] selection + sound? (= :audio (get-in (store/entry (:clip/current db)) + [:clip :symbols sid :nodes id :kind]))] + (cond-> (-> db + (assoc-in [:ui :selection] selection) + (update :ui dissoc :points :lane-retry)) + (and (= :node kind) path (not sound?)) + (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))) + +(defn target-of + "The target `selection` names: `{:sid :id :path}`, or nil for the open symbol + itself. + + All three parts, because a path alone cannot be looked up — one symbol placed + twice is two rows with the same node ids in them, so the row path says WHICH + and the sid says in which symbol's node map to find it. A selection made on + the stage carries no path; it names a node in the open symbol directly, and + the node's own id standing alone is that one-step path." + [selection] + (let [[kind sid id path] selection] + (when (and (= :node kind) id) + {:sid sid :id id :path (vec (or (seq path) [id]))}))) + +(defn aimed + "`db` with `selection` selected AND aimed: the target follows it." + [db selection] + (assoc-in (selected db selection) [:ui :target] (target-of selection))) + +(rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection))) + (rf/reg-event-db - ::select - ;; The rows above a selection are opened, so one made deep on the stage is - ;; seen in the timeline. Not a sound's: its row is always in the audio section, - ;; and opening the placement it is heard through would bury it. - (fn [db [_ selection]] - (let [[kind sid id path] selection - sound? (= :audio (get-in (store/entry (:clip/current db)) - [:clip :symbols sid :nodes id :kind]))] - (cond-> (-> db - (assoc-in [:ui :selection] selection) - (update :ui dissoc :points :lane-retry)) - (and (= :node kind) path (not sound?)) - (update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path)))))))) + ::aim + ;; The gestures that name a PLACE in the document rather than a thing on + ;; screen: a timeline row label, a cel-sheet column, a breadcrumb. + (fn [db [_ selection]] (aimed db selection))) + +(rf/reg-event-db + ::aim-at + ;; Aiming without selecting, for the cel sheet: the lane becomes where drawings + ;; go, and what is SELECTED stays whatever cel the sheet picked in it. + (fn [db [_ selection]] (assoc-in db [:ui :target] (target-of selection)))) (rf/reg-event-db ::set-tone (fn [db [_ tone]] (assoc-in db [:ui :tone] tone))) +(defn- aimed-lane + "The lane the target names, or nil — including nil for a target aimed at a cel + INSIDE a lane, which is the lane's business and not a lane itself." + [clip db] + (let [{:keys [sid id path]} (get-in db [:ui :target]) + n (when id (get-in clip [:symbols sid :nodes id]))] + (when (and n (node/lane? n) (= 1 (count path)) + (= sid (get-in db [:ui :open]))) + n))) + +(defn aim-a-lane + "`db` with a lane of the open symbol aimed, if one is not aimed already. + + THE CEL SHEET IS A DRAWING-LANE MODE, so being in it with nothing aimed is not + a state it has anything to say in: every cell belongs to a lane and every new + drawing goes in one. A symbol with no lane at all is the one honest exception, + and the view asks for one to be made rather than this inventing it." + [db] + (let [clip (:clip (store/entry (:clip/current db))) + open (get-in db [:ui :open])] + (if (aimed-lane clip db) + db + (if-let [lane (first (symbol/lanes (get-in clip [:symbols open :nodes])))] + (assoc-in db [:ui :target] {:sid open :id (:id lane) :path [(:id lane)]}) + (update db :ui dissoc :target))))) + (rf/reg-event-db ::set-time-view (fn [db [_ view]] (if (#{:timeline :cel-sheet} view) - (assoc-in db [:ui :time-view] view) + (cond-> (assoc-in db [:ui :time-view] view) + (= :cel-sheet view) aim-a-lane) db))) +(rf/reg-event-db + ::aim-a-lane + ;; The cel sheet asks for this when what it had aimed has gone — the lane + ;; deleted under it, or the open symbol changed beneath the view. + (fn [db _] (aim-a-lane db))) + (defn apply-lane-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." @@ -92,10 +174,16 @@ (rf/reg-event-db ::new-lane + ;; AND AIMED AT, because the reason to make a lane is to draw in it: `add-lane` + ;; returns the new lane as its selection, and `apply-lane-command` has already + ;; worked out the row path that addresses it. (fn [db _] (let [clip (:clip (store/entry (:clip/current db))) - sid (get-in db [:ui :open])] - (apply-lane-command db sid (lane/add-lane clip sid (random-uuid)) nil)))) + sid (get-in db [:ui :open]) + after (apply-lane-command db sid (lane/add-lane clip sid (random-uuid)) nil)] + (cond-> after + (not= (get-in after [:ui :selection]) (get-in db [:ui :selection])) + (assoc-in [:ui :target] (target-of (get-in after [:ui :selection]))))))) (defn- committed "One appending command, as effects: commit it, and look at what it made. @@ -181,35 +269,34 @@ {:refused "this lane's frames are not the open symbol's"})] (committed db sid result [::insert-drawing :grow-symbol])))) -(rf/reg-event-db - ::split-cel - (fn [db _] - (let [{clip :clip st :store} (store/entry (:clip/current db)) - selection (get-in db [:ui :selection]) - [_ sid id] selection - owner-frame (selection-frame clip st (get-in db [:ui :open]) selection - (get-in db [:playback :frame])) - cut (when (number? owner-frame) - (lane/lane-frame clip sid (:parent (get-in clip [:symbols sid :nodes id])) - owner-frame))] - (apply-lane-command - db sid (if cut - (lane/split clip sid id cut (random-uuid)) - {:refused "this lane's frames are not the open symbol's"}) - nil)))) - (defn- at-playhead - "The selected cel, its lane, and the playhead as a frame of that lane's - own time — or a refusal in place of the frame where there is no single one." + "The selected node and the playhead as a frame of the space that node is + POSITIONED in — its lane's, for a cel; the symbol's, for anything placed + straight into one. Nil in place of the frame where there is no single one. + + One helper for all three span commands, because `span/host-frame` asks the + node what it sits in rather than being told, so none of them has to care." [db] (let [{clip :clip st :store} (store/entry (:clip/current db)) selection (get-in db [:ui :selection]) - [_ sid id] selection - n (get-in clip [:symbols sid :nodes id])] - {:clip clip :sid sid :id id :node n + [_ sid id] selection] + {:clip clip :sid sid :id id + :node (get-in clip [:symbols sid :nodes id]) :at (when-let [owner-frame (selection-frame clip st (get-in db [:ui :open]) selection (get-in db [:playback :frame]))] - (lane/lane-frame clip sid (:parent n) owner-frame))})) + (span/host-frame clip sid id owner-frame))})) + +(def ^:private no-frame + "Said where the playhead maps to no single frame of the space the selection is + positioned in, which a stepped or looping parent is enough to cause." + {:refused "the playhead is not on one frame of what holds this"}) + +(rf/reg-event-db + ::split + (fn [db _] + (let [{:keys [clip sid id at]} (at-playhead db)] + (apply-lane-command + db sid (if at (span/split clip sid id at (random-uuid)) no-frame) nil)))) (rf/reg-event-fx ::overwrite-drawing @@ -229,24 +316,18 @@ (committed db sid result [::overwrite-drawing :grow-symbol])))) (rf/reg-event-db - ::trim-cel + ::trim (fn [db [_ edge]] (let [{:keys [clip sid id at]} (at-playhead db)] (apply-lane-command - db sid (if at - (lane/trim clip sid id edge at) - {:refused "this lane's frames are not the open symbol's"}) - nil)))) + db sid (if at (span/trim clip sid id edge at) no-frame) nil)))) (rf/reg-event-db - ::move-cel + ::move (fn [db _] (let [{:keys [clip sid id at]} (at-playhead db)] (apply-lane-command - db sid (if at - (lane/move clip sid id at) - {:refused "this lane's frames are not the open symbol's"}) - nil)))) + db sid (if at (span/move clip sid id at) no-frame) nil)))) (rf/reg-event-db ::blank-cel @@ -361,21 +442,22 @@ (update-in db [:ui :smart] #(let [on? (boolean on)] ((if on? conj disj) (set %) face))))) -(defn- where-new-goes +(defn where-new-goes "The row path, from the open symbol down, of the symbol a new thing goes into: - INSIDE the selected instance, or BESIDE any other selected node, or at the top - of the open symbol when nothing is selected. + INSIDE the aimed instance, or BESIDE an aimed node of any other kind, or at + the top of the open symbol when nothing is aimed. - A selection from a timeline row carries that row's path, because one symbol - placed twice is two rows and only the path says which was clicked. One made on - the stage does not, and names a node directly in the open symbol." + READ OFF THE TARGET, NEVER THE SELECTION. The two were one thing, and the + result was that clicking a shape on the stage to look at it re-aimed the next + polygon at whatever happened to hold that shape. `[:ui :target]` is a row + path, because one symbol placed twice is two rows and only the path says which + one was aimed at." [clip db] - (let [[kind sid id path] (get-in db [:ui :selection]) - path (when (= :node kind) (or path [id]))] + (let [{:keys [sid id path]} (get-in db [:ui :target])] (cond - (nil? path) [] + (empty? path) [] (= :instance (get-in clip [:symbols sid :nodes id :kind])) path - :else (pop path)))) + :else (vec (butlast path))))) ;; --------------------------------------------------------------------------- ;; drawing a polygon @@ -386,11 +468,6 @@ ;; reload is worth more than the handful of dispatches it costs. Clicks are rare; ;; this is not the drag path. -(rf/reg-event-db - ::begin-polygon - ;; The selection is KEPT: a selected instance is where the new shape will go. - (fn [db _] (update db :ui merge {:tool :polygon :draft []}))) - (rf/reg-event-db ::cancel-polygon (fn [db _] (update db :ui merge {:tool nil :draft []}))) @@ -402,22 +479,128 @@ (update-in db [:ui :draft] into [x y]) db))) -(rf/reg-event-fx +(defn into-the-lane + "Where a polygon drawn in the CEL SHEET goes: the row path of the cel the + aimed lane exposes at the playhead, and the clip that cel is in. `{:clip + :path}`, or `{:refused why}`. + + A GAP IS NOT A REFUSAL, IT IS A NEW DRAWING. The sheet is a drawing-lane mode + and the frame under the playhead is where the drawing belongs, so drawing on + an empty frame makes the drawing that was missing — which is the whole reason + there is no `new drawing` button any more: the gesture already says it. + + `overwrite-drawing` rather than `append-drawing`, because a gap already has + the room. Appending RIPPLES everything after it later by the new cel's + duration — that is what `insert` means, and it is a different intention. + Placed into a gap, overwrite clears nothing and moves nobody. + + A CEL'S PATH IS ONE STEP. `[cel]` and not `[lane cel]`: within one symbol the + rows are flat and a cel is not a row at all, which is the same addressing + `rows` hands the timeline and `trail` reads back." + [clip st db lane] + (let [open (get-in db [:ui :open]) + lane-id (:id lane) + owner (:frame (nest/inside clip st open [] (get-in db [:playback :frame]))) + at (when (number? owner) (lane/lane-frame clip open lane-id owner)) + cel (when (integer? at) + (some (fn [c] (let [[lo hi] (node/placed-span c)] + (when (and (<= lo at) (< at hi)) c))) + (symbol/lane-cels (get-in clip [:symbols open :nodes]) lane-id)))] + (cond + (not (integer? at)) + {:refused "the playhead is not on one frame of this lane"} + cel {:clip clip :path [(:id cel)]} + :else + (let [cel-id (random-uuid) + made (lane/overwrite-drawing clip open lane-id cel-id (clip/fresh-id clip) at + {:extent :grow-symbol + :remainder-id (random-uuid)})] + (if (:refused made) made {:clip (:clip made) :path [cel-id]}))))) + +(defn polygon-landing + "Choose the document and row path a finished polygon is drawn into. + + In the timeline this follows the explicit target. In the cel sheet the aimed + lane wins, regardless of what is selected on the stage: an occupied frame + lands in its cel and a gap first becomes a drawing. Keeping this decision out + of the event handler makes the selection/target boundary a rule we can assert + without driving re-frame." + [clip st db] + (if (= :cel-sheet (get-in db [:ui :time-view] :timeline)) + (if-let [lane (aimed-lane clip db)] + (assoc (into-the-lane clip st db lane) :lane? true) + {:refused "make a drawing lane to draw in — the cel sheet has none" + :lane? true}) + {:clip clip :path (where-new-goes clip db) :lane? false})) + +(defn beginning-polygon + "Enter polygon mode, first materializing the cel-sheet lane and drawing when + either is missing. In the timeline this is editor state only. + + Creating here, rather than when the polygon is finished, means the drawing is + already the current cel while points are being placed. Cancelling the polygon + cancels only the draft; the explicitly started drawing remains." + [db] + (let [{clip :clip st :store} (store/entry (:clip/current db)) + open (get-in db [:ui :open]) + sheet? (= :cel-sheet (get-in db [:ui :time-view] :timeline)) + no-lanes? (and sheet? + (empty? (symbol/lanes (get-in clip [:symbols open :nodes])))) + lane-id (when no-lanes? (random-uuid)) + lane-result (if no-lanes? + (lane/add-lane clip open lane-id) + {:clip clip}) + aimed-db (if (and no-lanes? (not (:refused lane-result))) + (assoc-in db [:ui :target] + {:sid open :id lane-id :path [lane-id]}) + db) + landing (if-let [why (:refused lane-result)] + {:refused why :lane? true} + (polygon-landing (:clip lane-result) st aimed-db)) + source (:clip landing) + made? (and source (not (identical? clip source))) + db' (cond + (:refused landing) + (update db :project merge {:status (:refused landing)}) + + made? + (-> aimed-db + (edit/transaction (constantly source)) + (assoc-in [:ui :selection] + [:node open + (peek (:path landing)) (:path landing)])) + + :else aimed-db)] + (if (:refused landing) + db' + (update db' :ui merge {:tool :polygon :draft []})))) + +(rf/reg-event-db + ::begin-polygon + (fn [db _] (beginning-polygon db))) + +(rf/reg-event-db ::finish-polygon - (fn [{:keys [db]} _] + ;; The drawing already exists from `::begin-polygon`; finishing commits only + ;; the shape, so cancelling a draft does not undo the drawing that was started. + (fn [db _] (let [draft (get-in db [:ui :draft]) open (get-in db [:ui :open]) {clip :clip st :store} (store/entry (:clip/current db)) - down (where-new-goes clip db) - ;; 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]} (nest/drawn-inside clip st open down - (get-in db [:playback :frame]) draft)] + landing (polygon-landing clip st db) + source (:clip landing) + down (:path landing) + {:keys [sid frame pts]} + (when-not (:refused landing) + (nest/drawn-inside source st open down (get-in db [:playback :frame]) draft))] (cond - (< (count draft) 6) {} - (nil? sid) {:db (update db :project merge - {:status "the selected instance is not on screen at this frame"})} + (< (count draft) 6) db + (:refused landing) (update db :project merge {:status (:refused landing)}) + (nil? sid) + (update db :project merge + {:status (if (:lane? landing) + "this lane is not on screen at this frame" + "what you are drawing into is not on screen at this frame")}) ;; `random-uuid` is the one impurity in this namespace, and it is here ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells ;; out: a node's id is its identity in the saved document, so the pure @@ -425,38 +608,57 @@ ;; log ever has to reproduce a document exactly, this becomes a cofx. :else (let [id (keyword (str "paint-" (random-uuid)))] - {:db (-> db - (update :ui merge {:tool nil :draft [] - :selection [:node sid id (conj down id)]}) - (update-in [:ui :expanded] into (rest (reductions conj [] down)))) - :dispatch [::paint/new-shape sid id frame pts (get-in db [:ui :tone])]}))))) + (-> db + (edit/transaction + (fn [_] (paint/new-shape source sid id frame pts (get-in db [:ui :tone])))) + (update :ui merge {:tool nil :draft [] + :selection [:node sid id (conj down id)]}) + (update-in [:ui :expanded] (fnil into #{}) + (rest (reductions conj [] down))))))))) (rf/reg-event-db ::set-knob (fn [db [_ scope id knob value]] (assoc-in db [:ui :knobs [scope id knob]] value))) +(rf/reg-event-db + ::toggle-auto-key + (fn [db _] + (update-in db [:ui :auto-key?] not))) + +(declare record-auto-frame) + ;; --------------------------------------------------------------------------- ;; a new symbol (rf/reg-event-db ::new-symbol - (fn [db _] + ;; `where` is `:inside` — in whatever the target names — or `:top`, in the open + ;; symbol regardless of it. Two items on one menu rather than a rule nobody can + ;; see: `lane-model.md` asks that "creation controls next to the breadcrumb act + ;; in that explicit location", and the honest way to offer the other location is + ;; to offer it. + (fn [db [_ where]] (let [{clip :clip st :store} (store/entry (:clip/current db)) - down (where-new-goes clip db) + down (if (= :top where) [] (where-new-goes clip db)) {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)] (if-not host (update db :project merge - {:status "the selected instance is not on screen at this frame"}) - (-> db - (edit/edit #(clip/new-symbol % host sid frame uuid)) - (assoc-in [:ui :selection] [:node host uuid (conj down uuid)]) - ;; Open every row down to it, or the new row is inside a closed one - ;; and the button looks like it did nothing. - (update-in [:ui :expanded] into (rest (reductions conj [] down)))))))) + {:status "what you are adding to is not on screen at this frame"}) + (let [made [:node host uuid (conj down uuid)]] + (-> db + (edit/transaction #(clip/new-symbol % host sid frame uuid)) + ;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the + ;; next thing made goes in it; the outline says so before anybody + ;; has to find out by drawing. + (aimed made) + ;; Open every row down to it, or the new row is inside a closed one + ;; and the button looks like it did nothing. + (update-in [:ui :expanded] (fnil into #{}) + (rest (reductions conj [] down))))))))) ;; --------------------------------------------------------------------------- ;; a drop in flight @@ -558,15 +760,57 @@ ::gesture ;; A transform in the middle of a drag on the stage, `{:sid :id :frame ;; :values}`, drawn by `::render/clip` as `::sliding` is; nil when abandoned. + ;; Auto-key SAMPLES once per playback frame but does not EDIT once per frame. + ;; Samples stay in the gesture's in-memory `:take`; pointer events only replace + ;; the current frame's sample. Pointer-up commits the complete take once. (fn [db [_ g]] - (if g (assoc-in db [:ui :gesture] g) (update db :ui dissoc :gesture)))) + (let [active (get-in db [:ui :gesture]) + auto? (if active (:auto-key? active) (boolean (get-in db [:ui :auto-key?])))] + (if g + (let [g (merge active g {:auto-key? auto?}) + db (assoc-in db [:ui :gesture] g)] + ;; Materialize the current frame immediately. More pointer moves in the + ;; same frame only replace the preview; pointer-up forces its last value. + (if auto? + (record-auto-frame db (get-in db [:playback :frame])) + db)) + (update db :ui dissoc :gesture))))) + +(defn record-auto-frame + "Buffer the active gesture at outer playback frame `f`, mapped to the node's + local frame. Repeated pointer events replace that frame's sample cheaply." + [db f] + (let [{:keys [auto-key? open path values] :as g} + (get-in db [:ui :gesture])] + (if (and auto-key? (seq values)) + (let [{document :clip st :store} (store/entry (:clip/current db))] + (if-let [{:keys [sid id frame]} (nest/placement document st open path f)] + (assoc-in db [:ui :gesture] + (-> g + (assoc :sid sid :id id :frame frame) + (assoc-in [:take [sid id] frame] values))) + db)) + db))) + +(rf/reg-event-db + ::record-gesture + (fn [db [_ f]] (record-auto-frame db f))) (rf/reg-event-db ::transform ;; The drag let go: one edit, so one undo step and one write to collaborators. - (fn [db [_ {:keys [sid id frame values]}]] - (cond-> (update db :ui dissoc :gesture) - (seq values) (edit/edit #(gesture/apply-values % sid id frame values))))) + (fn [db [_ g]] + (let [auto? (boolean (get-in db [:ui :gesture :auto-key?]))] + (if auto? + (let [db (-> db + (update-in [:ui :gesture] merge g) + (record-auto-frame (get-in db [:playback :frame]))) + take (get-in db [:ui :gesture :take])] + (cond-> (update db :ui dissoc :gesture) + (seq take) (edit/edit #(gesture/apply-take % take)))) + (let [{:keys [sid id frame values]} g] + (cond-> (update db :ui dissoc :gesture) + (seq values) (edit/edit #(gesture/apply-values % sid id frame values false)))))))) (rf/reg-event-db ::delete-selected diff --git a/frontend/src/arthur/subs/render.cljs b/frontend/src/arthur/subs/render.cljs index 7f69a51..f6716df 100644 --- a/frontend/src/arthur/subs/render.cljs +++ b/frontend/src/arthur/subs/render.cljs @@ -47,7 +47,12 @@ (or (when-let [{:keys [path df]} sliding] (:clip (nest/slide c open path df))) (when-let [{:keys [sid id frame values]} gesture] - (when c (gesture/apply-values c sid id frame values))) + ;; A held stage control owns the touched parameters completely. Make + ;; them temporary static channels for the preview, so their existing + ;; automation cannot pull against the pointer while the performance + ;; recorder samples the live value in the background. Pointer-up + ;; removes this preview and commits the buffered take as real keys. + (when c (gesture/apply-values c sid id frame values false))) c)))) (rf/reg-sub diff --git a/frontend/src/arthur/subs/ui.cljs b/frontend/src/arthur/subs/ui.cljs index bb044c0..4086778 100644 --- a/frontend/src/arthur/subs/ui.cljs +++ b/frontend/src/arthur/subs/ui.cljs @@ -12,10 +12,12 @@ [re-frame.core :as rf])) (rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection]))) +(rf/reg-sub ::target (fn [db _] (get-in db [:ui :target]))) (rf/reg-sub ::time-view (fn [db _] (get-in db [:ui :time-view] :timeline))) (rf/reg-sub ::lane-retry (fn [db _] (get-in db [:ui :lane-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 ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?])))) (rf/reg-sub ::draft (fn [db _] (get-in db [:ui :draft]))) (rf/reg-sub ::convert (fn [db _] (get-in db [:ui :convert]))) (rf/reg-sub ::drop (fn [db _] (get-in db [:ui :drop]))) @@ -53,6 +55,35 @@ (let [{clip :clip st :store} (store/entry clip-id)] (nest/inside clip st open (or path [id]) f))))) +(rf/reg-sub + ::target-node + :<- [::target] + :<- [::render/clip] + (fn [[{:keys [sid id]} clip] _] + ;; The node a new thing would be parented to, for the outline that says so. + ;; `[sid id node]` as `::selected-node` gives it, so the two read alike. + (when (and clip id) + (when-let [n (get-in clip [:symbols sid :nodes id])] + [sid id n])))) + +(rf/reg-sub + ::target-placement + :<- [::target] + :<- [::target-node] + :<- [::render/clip] + :<- [::render/clip-id] + :<- [::render/open] + :<- [::playback/frame] + (fn [[{:keys [path]} [_ id n] clip clip-id open f] _] + ;; `nest/placement` of the TARGET, with the bounds of what it draws — the + ;; same work `::selected-placement` does, kept separate because the two are + ;; separate states and are drawn differently: the target gets an outline and + ;; a tag, the selection gets handles. + (when n + (let [st (:store (store/entry clip-id))] + (when-let [pl (nest/placement clip st open (or path [id]) f)] + (assoc pl :node n :bounds ((pick/bounds-of clip st (:sid pl) n) (:frame pl)))))))) + (rf/reg-sub ::selected-placement :<- [::selected-node] diff --git a/frontend/src/arthur/ui/location.cljs b/frontend/src/arthur/ui/location.cljs index 2e5b874..cb29e29 100644 --- a/frontend/src/arthur/ui/location.cljs +++ b/frontend/src/arthur/ui/location.cljs @@ -139,7 +139,13 @@ crumbs (trail clip open (if (and n (seq path)) path (when n [id]))) last-i (dec (count crumbs)) shared (shared-with clip n) - says (whereabouts clip n inside)] + says (whereabouts clip n inside) + ;; WHAT IS AIMED, which is not what is selected: the menu has to name + ;; the place it would add to, and that place is the target. Named the + ;; way the trail names a crumb, so the menu and the outline's tag and + ;; the breadcrumb all call one node by one name. + aimed (let [[tsid tid tn] @(rf/subscribe [::sub/target-node])] + (when tn (crumb-label clip tid tn)))] [:section.loc [:nav.crumbs {:aria-label "editing location"} (doall @@ -154,7 +160,9 @@ :title (if (zero? i) "the open symbol — clear the selection" (str label " · " (if lane? "lane" (name crumb-kind)))) - :on-click #(rf/dispatch [::ui/select (when (pos? i) select)])} + ;; A CRUMB AIMS, because this bar is the one that says where an + ;; edit would land: going out to a level is going there to work. + :on-click #(rf/dispatch [::ui/aim (when (pos? i) select)])} label]]))] (when says [:span.loc-fact {:title "the frame this selection is showing, in its own time"} @@ -173,10 +181,23 @@ ;; explicit location." Both commands read the selection, and the trail to ;; the left of them is that selection written out. [menu/view - {:label "new" :title "add to the document, at the location named on the left" - :items [{:label "symbol" - :sub "empty, inside the selected instance or beside the selected node" - :on-click #(rf/dispatch [::ui/new-symbol])} + {:label "new" :title "add to the document" + :items [{:label "inside" + :sub (if aimed + (str "a symbol in " aimed " — the outlined one") + (str "a symbol at the top of " (clip/symbol-name clip open) + ", since nothing is aimed")) + :on-click #(rf/dispatch [::ui/new-symbol :inside])} + ;; THE SECOND ITEM IS THE POINT OF THE MENU. With one item it was + ;; impossible to add anything at the top of the open symbol + ;; without first clearing the aim, which meant the only way out + ;; of a nesting was to leave it — and nobody could see the rule + ;; they were working against. + {:label "at top" + :disabled? (nil? aimed) + :sub (str "a symbol straight into " (clip/symbol-name clip open) + ", ignoring what is aimed") + :on-click #(rf/dispatch [::ui/new-symbol :top])} {:label "lane" - :sub "a row that holds one drawing after another" + :sub (str "a row of drawings in " (clip/symbol-name clip open)) :on-click #(rf/dispatch [::ui/new-lane])}]}]])) diff --git a/frontend/src/arthur/ui/palette.cljs b/frontend/src/arthur/ui/palette.cljs index 2e59458..79cd841 100644 --- a/frontend/src/arthur/ui/palette.cljs +++ b/frontend/src/arthur/ui/palette.cljs @@ -42,11 +42,19 @@ (defn bar [] (let [tone @(rf/subscribe [::sub/tone]) tool @(rf/subscribe [::sub/tool]) + auto? @(rf/subscribe [::sub/auto-key?]) draft @(rf/subscribe [::sub/draft])] [:div.palette-bar [:div.swatches (doall (map #(swatch % tone) (range slots)))] [:span.dim (name tone)] [:span {:style {:flex 1}}] + [:button.auto-key {:class (when auto? "on") + :aria-pressed auto? + :title (if auto? + "auto-key is on — edited parameters get a key at this frame" + "auto-key edited parameters at this frame") + :on-click #(rf/dispatch [::ui/toggle-auto-key])} + "◆ auto key"] (if (= :polygon tool) [:<> [:span.dim (str (quot (count draft) 2) " points")] diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index 9bf21b1..cc67730 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/frontend/src/arthur/ui/params.cljs @@ -167,7 +167,7 @@ ;; Rotation is shown in degrees. Between two keys, the gap after the one here ;; holds or tweens, as a drawing's does. -(defn- channel-control [sid id path ch frame] +(defn- channel-control [sid id path ch frame auto-key?] (let [keyed? (some? (:keys ch)) ;; No store: the call site below hands this only channels that are not ;; `:dense`, which are the only ones with anything in tier 2 to read. @@ -184,7 +184,7 @@ :value (if deg? (/ (js/Math.round (* x (/ 18000 js/Math.PI))) 100) x) :parse js/parseFloat :on-number #(on-number (if deg? (* % (/ js/Math.PI 180)) %))}])] - [:dd.channel + [:dd.channel {:class (when auto-key? "live")} [:button.key {:class (cond (contains? (:keys ch) frame) "on" keyed? "keyed") :disabled (nil? frame) :title (if keyed? (str (count (:keys ch)) " keys") "key this here") @@ -199,7 +199,8 @@ (when gap? [segment-select sid id path ch left])])) (defn- node-section [[sid id n]] - (let [[start end] (:span n)] + (let [[start end] (:span n) + auto-key? @(rf/subscribe [::sub/auto-key?])] [section (str (name (:kind n)) " · in " (name sid)) [facts "name" (or (:name n) (brief id)) @@ -221,7 +222,7 @@ [:<> [:dt (str/join " " (map name path))] (if (and (contains? (node/defaults-of n) path) (not (:dense ch))) - [channel-control sid id path ch frame] + [channel-control sid id path ch frame auto-key?] [:dd (channel-state ch)])]))])])) ;; --------------------------------------------------------------------------- diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs index d82a249..76470b3 100644 --- a/frontend/src/arthur/ui/stage.cljs +++ b/frontend/src/arthur/ui/stage.cljs @@ -150,11 +150,11 @@ (when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)] (let [n (get-in document [:symbols sid :nodes id]) v0 (gesture/values n frame st)] - (reset! gesture {:kind kind :pl pl :v0 v0 :p0 p :n n + (reset! gesture {:kind kind :pl pl :path path :open open :v0 v0 :p0 p :n n :a (gesture/angle pl v0 p) :turned 0}))))) (defn- drag! [p ^js event] - (let [{:keys [kind pl v0 p0 n a turned values]} @gesture + (let [{:keys [kind pl path open v0 p0 n a turned values]} @gesture shift? (.-shiftKey event) moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))] (when moved? @@ -174,14 +174,17 @@ t))))] (when vs (swap! gesture assoc :values vs) - (rf/dispatch [::ui/gesture (assoc (select-keys pl [:sid :id :frame]) :values vs)]))))))) + (rf/dispatch [::ui/gesture + (assoc (select-keys pl [:sid :id :frame]) + :path path :open open :values vs)]))))))) (defn- let-go! [commit?] - (when-let [{:keys [pl values]} @gesture] + (when-let [{:keys [pl path open values]} @gesture] (reset! gesture nil) (when values (rf/dispatch (if commit? - [::ui/transform (assoc (select-keys pl [:sid :id :frame]) :values values)] + [::ui/transform (assoc (select-keys pl [:sid :id :frame]) + :path path :open open :values values)] [::ui/gesture nil]))))) (defn- handles @@ -220,6 +223,45 @@ [:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3) " M " px " " (- py 3) " V " (+ py 3))}]]))) +(defn- aim-box + "The TARGET's outline: where a new polygon or symbol would be parented, drawn + around the thing that would be its parent. + + NOT THE SELECTION'S BOX AND DELIBERATELY NOT LIKE IT. The selection gets + handles, because handles are how you change it; the target gets an outline + with nothing to grab, because there is nothing to change about being aimed at. + Same geometry — the node's bounds through its own transform, so it turns with + what it is around — and a different statement. + + THE TAG IS IN SCREEN SPACE, THE BOX IS NOT. The box goes through the node's + matrix and therefore rotates; a name rotated with it would be unreadable at + exactly the angles somebody is most likely to be working at. So the tag is + pinned to whichever drawn corner ended up furthest bottom-right and written + horizontally, just outside it. Its font size is in user units because this SVG + carries a `viewBox` scaled by `zoom`, which is also why the stroke widths + nearby are fractions." + [] + (let [{:keys [world bounds]} @(rf/subscribe [::sub/target-placement]) + [_ id n] @(rf/subscribe [::sub/target-node]) + label (or (:name n) (some-> (node/source n) name) + (when id (if (keyword? id) (subs (str id) 1) (subs (str id) 0 8))))] + (when (and world bounds) + (let [[x0 y0 x1 y1] bounds + corners (pairs (through world [x0 y0 x1 y0 x1 y1 x0 y1])) + ;; Furthest bottom-right of the four as drawn: the corner a reader + ;; would call "the bottom right" whatever the node has been turned to. + [tx ty] (apply max-key (fn [[x y]] (+ x y)) corners)] + [:g.aim {:pointer-events "none"} + [:polygon.aim-box {:points (points-text (flatten corners))}] + (when label + [:g {:transform (str "translate(" (+ tx 1.5) " " (+ ty 1.5) ")")} + ;; The plate behind the text, sized off the string rather than + ;; measured: `textLength` would need a layout pass, and a tag that + ;; is a little wide is better than one that reflows the frame. + [:rect.aim-tag-bg {:x 0 :y 0 :rx 0.8 + :width (+ 2 (* 2.1 (count label))) :height 5}] + [:text.aim-tag {:x 1 :y 3.8} label]])])))) + (defn- overlay [w h] (let [tool @(rf/subscribe [::sub/tool]) draft @(rf/subscribe [::sub/draft]) @@ -280,6 +322,10 @@ (when (seq draft) [:polyline {:points (points-text draft) :fill "none" :stroke "#d0ba86" :stroke-width 1}]) + ;; DRAWN WHILE DRAWING, unlike the handles. "Where will this polygon land" + ;; is the question the outline exists to answer, and the moment it is being + ;; asked is mid-draft. + (when-not points? [aim-box]) (when-not (or drawing? points?) [handles ctx]) (when (and id pts (not drawing?) (not (channel/nothing? pts))) [:g diff --git a/frontend/src/arthur/ui/timeline.cljs b/frontend/src/arthur/ui/timeline.cljs index e154a06..79689a2 100644 --- a/frontend/src/arthur/ui/timeline.cljs +++ b/frontend/src/arthur/ui/timeline.cljs @@ -25,6 +25,7 @@ [arthur.domain.clip :as clip] [arthur.domain.nest :as nest] [arthur.domain.lane :as lane] + [arthur.domain.span :as span] [arthur.domain.symbol :as symbol] [arthur.domain.trace :as trace] [arthur.events.playback :as pb] @@ -240,25 +241,34 @@ [_ sid id] selection open @(rf/subscribe [::render/open]) st (:store (store/entry clip-id)) + sheet? (= :cel-sheet view) n (get-in clip [:symbols sid :nodes id]) lane (if (node/lane? n) n (get-in clip [:symbols sid :nodes (:parent n)])) lane? (node/lane? lane) cel? (and lane? (= :instance (:kind n)) (some? (node/source n))) held? (and cel? (zero? (:speed (node/playback-of n)))) - ;; Shared use is shown rather than discovered: the row that decouples - ;; a cel is only offered where there is something to decouple from. - shared? (and cel? (< 1 (count (for [[_ sym] (:symbols clip) - [_ other] (:nodes sym) - :when (= (node/source n) (node/source other))] - other)))) - ;; Both act at the playhead, so both are offered only where the playhead - ;; is somewhere they mean something. + ;; A SPAN IS A SPAN WHEREVER IT SITS. What `span/split`, `trim` and + ;; `move` need is one node with a place in time, which a symbol dropped + ;; straight into a shot has as surely as a cel does — so these are + ;; offered on both, and a GROUP is the exception rather than a lane + ;; being the rule: dividing one means deciding what becomes of its + ;; children, and nothing in a span says. + span? (and n (not= :group (:kind n)) (some? (node/placed-span n))) + ;; Every one of them acts at the playhead, so every one is offered only + ;; where the playhead is somewhere it means something. owner-frame (ui/selection-frame clip st open selection frame) + ;; TWO COORDINATES AND THEY ARE NOT THE SAME. `host` is the frame of + ;; whatever the selection is positioned in — its lane, for a cel; the + ;; symbol, for a free placement — and is what the span commands take. + ;; `at` is the LANE's own frame, which is what the lane commands take and + ;; which only exists when there is a lane. + host (when (number? owner-frame) (span/host-frame clip sid id owner-frame)) + cuttable? (and span? (integer? host) + (let [[lo hi] (node/placed-span n)] (< lo host hi))) + movable? (and span? (integer? host)) at (when (and lane? (number? owner-frame)) (lane/lane-frame clip sid (:id lane) owner-frame)) insertable? (and lane? (integer? at)) - splittable? (and cel? (integer? at) - (let [[lo hi] (node/placed-span n)] (< lo at hi))) act (fn [event] #(rf/dispatch event))] [:div.pane-head ;; ----------------------------------------------------------------- time @@ -313,67 +323,82 @@ label]))] [:span.sep] ;; ------------------------------------------------------------- commands - ;; Fourteen of these, and all but two mean nothing without a selected lane - ;; or cel — so as buttons they were a permanent grey hedge across the strip - ;; with their explanations hidden in `title`. Grouped by what they change, - ;; with the explanation on the row, they cost three slots and read as a - ;; vocabulary. There is also room here for the correction commands, which - ;; `docs/lane-handoff.md` says are next. - ;; `new` is NOT here. Creating a symbol or a lane acts at the location the - ;; breadcrumb names, so it lives on the location bar beside it rather than - ;; among the commands that act on a cel. `ui/location`. + ;; GROUPED BY WHAT THEY NEED, not by which view they were built in. + ;; + ;; `timing` is always here. Split, trim and move are one write to one + ;; node's span or position, and that is a fact every placement has: a + ;; symbol laid out in a shot is cut and trimmed exactly as a cel is, and + ;; the lane gate they used to carry was a leftover from a lane being the + ;; only thing anybody had timed. Judging a cut against the other rows is + ;; also the timeline's whole shape, so hiding them here would have cost + ;; the view the one thing it is best at. + ;; + ;; `drawing` and `hold` are the CEL SHEET's and appear only there. Each one + ;; needs a SEQUENCE — a ripple needs later siblings, a gap needs a row to + ;; be a hole in — and a sequence is what a lane is. Choosing how many + ;; frames a drawing is exposed for is plate-side work; the timeline is the + ;; performance side. + ;; + ;; `new drawing` is NOT here, in either view. Drawing a polygon on an empty + ;; frame of the aimed lane makes the drawing that was missing, so the + ;; button said what the gesture already says. `N` still does it from the + ;; sheet, for the draw-N-draw-N rhythm that wants a key and not a menu. + ;; + ;; `make unique` is NOT here either. It is offered on the location bar, + ;; beside the count of how many places share the drawing — which is the + ;; fact somebody needs before deciding to decouple one, and is why that row + ;; exists at all. `ui/location`. + ;; + ;; `new` is on the location bar for the same kind of reason: creating a + ;; symbol acts at the location the breadcrumb names, not on a cel. [menu/view - {:label "drawing" :title "what the lane exposes" - :note "select a lane, or a cel in one" - :items [{:label "new drawing" :disabled? (not lane?) - :sub "append a new independent drawing to the selected lane" - :on-click (act [::ui/append-drawing])} - {:label "insert" :disabled? (not insertable?) - :sub "a new drawing at the playhead; later drawings ripple later" - :on-click (act [::ui/insert-drawing])} - {:label "overwrite" :disabled? (not insertable?) - :sub "replace the drawing at the playhead; later drawings stay put" - :on-click (act [::ui/overwrite-drawing])} - {:label "reuse" :disabled? (not cel?) - :sub "expose this same drawing again — one drawing, two cels" - :on-click (act [::ui/reuse-drawing])} - {:label "duplicate" :disabled? (not cel?) - :sub "append a copy of this drawing, to draw the next one over it" - :on-click (act [::ui/duplicate-drawing])} - {:label "make unique" :disabled? (not shared?) - :sub "give this cel its own copy; other cels keep sharing" - :on-click (act [::ui/make-unique])}]}] - [menu/view - {:label "cel" :title "where this cel sits and how long it lasts" - :note "select a cel in the timeline or the cel sheet" - :items [{:label "split" :disabled? (not splittable?) - :sub "cut this cel in two at the playhead; the picture does not change" - :on-click (act [::ui/split-cel])} - {:label "trim in" :disabled? (not splittable?) - :sub "start this cel at the playhead; nothing else moves" - :on-click (act [::ui/trim-cel :in])} - {:label "trim out" :disabled? (not splittable?) - :sub "end this cel at the playhead; nothing else moves" - :on-click (act [::ui/trim-cel :out])} - {:label "move here" :disabled? (not (and cel? (integer? at))) - :sub "put this cel at the playhead; refused if something is there" - :on-click (act [::ui/move-cel])} - {:label "blank" :disabled? (not cel?) - :sub "clear this cel's frames, leaving a gap; later drawings stay put" - :on-click (act [::ui/blank-cel])}]}] - ;; THE ONE PAIR THAT STAYS A BUTTON. Deciding how many frames a drawing is - ;; held for is shooting on ones or twos — the most repeated edit in the - ;; list, done by eye, a frame at a time. Two clicks into a menu per frame - ;; would be the one place this consolidation made the tool worse. - [:span.stepper - [:span.stepper-label "hold"] - [:span.group - [:button {:disabled (not held?) :aria-label "hold −" - :title "shorten this cel; ripple later drawings, keeping lane keys fixed" - :on-click (act [::ui/extend-hold -1])} "−"] - [:button {:disabled (not held?) :aria-label "hold +" - :title "extend this cel; ripple later drawings, keeping lane keys fixed" - :on-click (act [::ui/extend-hold 1])} "+"]]] + {:label "timing" :title "where this sits and how long it lasts" + :note "select a cel, or anything else placed in time" + :items [{:label "split" :disabled? (not cuttable?) + :sub "cut this in two at the playhead; the picture does not change" + :on-click (act [::ui/split])} + {:label "trim in" :disabled? (not cuttable?) + :sub "start this at the playhead; nothing else moves" + :on-click (act [::ui/trim :in])} + {:label "trim out" :disabled? (not cuttable?) + :sub "end this at the playhead; nothing else moves" + :on-click (act [::ui/trim :out])} + {:label "move here" :disabled? (not movable?) + :sub "put this at the playhead; in a lane, refused if something is there" + :on-click (act [::ui/move])}]}] + (when sheet? + [:<> + [menu/view + {:label "drawing" :title "what the aimed lane exposes" + :note "select a cel in the sheet" + :items [{:label "insert" :disabled? (not insertable?) + :sub "a new drawing at the playhead; later drawings ripple later" + :on-click (act [::ui/insert-drawing])} + {:label "overwrite" :disabled? (not insertable?) + :sub "replace the drawing at the playhead; later drawings stay put" + :on-click (act [::ui/overwrite-drawing])} + {:label "reuse" :disabled? (not cel?) + :sub "expose this same drawing again — one drawing, two cels" + :on-click (act [::ui/reuse-drawing])} + {:label "duplicate" :disabled? (not cel?) + :sub "append a copy of this drawing, to draw the next one over it" + :on-click (act [::ui/duplicate-drawing])} + {:label "blank" :disabled? (not cel?) + :sub "clear this cel's frames, leaving a gap; later drawings stay put" + :on-click (act [::ui/blank-cel])}]}] + ;; THE ONE PAIR THAT STAYS A BUTTON. Deciding how many frames a drawing + ;; is held for is shooting on ones or twos — the most repeated edit in + ;; the list, done by eye, a frame at a time. Two clicks into a menu per + ;; frame would be the one place this consolidation made the tool worse. + [:span.stepper + [:span.stepper-label "hold"] + [:span.group + [:button {:disabled (not held?) :aria-label "hold −" + :title "shorten this cel; ripple later drawings, keeping lane keys fixed" + :on-click (act [::ui/extend-hold -1])} "−"] + [:button {:disabled (not held?) :aria-label "hold +" + :title "extend this cel; ripple later drawings, keeping lane keys fixed" + :on-click (act [::ui/extend-hold 1])} "+"]]]]) [:span.spacer] ;; After the spacer, both of them: an offer that appears and a reading that ;; comes and goes must not shove the fixed controls sideways when they do. @@ -419,10 +444,16 @@ (memoize (fn [_selection] (fn [el] (some-> el (.scrollIntoView #js {:block "nearest"})))))) (defn- label-cell [{:keys [path depth label kind node-kind select expandable? expanded? of via]} - selection over solo tracing] + selection target over solo tracing] (let [node? (= :node kind) + ;; AIMED IS NOT SELECTED, so it does not wear the selected class. The + ;; target is where a new thing would go; the selection is what the + ;; inspector is showing. One row is often both and must still say which + ;; of the two it is being. + aimed? (and node? (= path (:path target))) [over-path where] @over] [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on") + (when aimed? " aimed") (when (= :ghost kind) " ghost") (when (= path over-path) (case where @@ -432,7 +463,12 @@ :style {:padding-left (str (+ 4 (* 11 depth)) "px")} :title label :ref (when (and select (= select selection)) (reveal selection)) - :on-click #(when select (rf/dispatch [::ui/select select])) + ;; A LABEL AIMS. Clicking a row's name says "I am working + ;; here", which is a statement about a place in the document; + ;; clicking its bar or one of its cels, below, says "show me + ;; this", which is a statement about a thing on screen. Only + ;; the first moves where new drawings and symbols go. + :on-click #(when select (rf/dispatch [::ui/aim select])) ;; An instance's row opens the symbol it places, as a tab. :on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))} ;; A node's row can be dragged onto another: onto an instance's, to @@ -578,6 +614,7 @@ frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frame @(rf/subscribe [::playback/frame]) selection @(rf/subscribe [::sub/selection]) + target @(rf/subscribe [::sub/target]) expanded @(rf/subscribe [::sub/expanded]) drop @(rf/subscribe [::sub/drop]) solo (set @(rf/subscribe [::render/solo])) @@ -626,7 +663,7 @@ (doall (for [row visible] (with-meta (if (= :section (:kind row)) [:div.tl-label.tl-section (:label row)] - [label-cell row selection over solo tracing]) + [label-cell row selection target over solo tracing]) {:key (str (:path row))})))] [:div.tl-tracks {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) @@ -708,7 +745,16 @@ frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frame @(rf/subscribe [::playback/frame]) selection @(rf/subscribe [::sub/selection]) + target @(rf/subscribe [::sub/target]) columns (cel-sheet clip sid frames) + ;; THE AIMED LANE, and there is always one while this view is up. The + ;; sheet is a drawing-lane mode: every cell belongs to a lane and every + ;; new drawing goes in one, so "nothing aimed" is a state it has nothing + ;; to say in. Enforced HERE rather than in the event that switches view, + ;; because the lane can also go stale under it — deleted, or the open + ;; symbol changed — and this is the only place that notices. + aimed (when (some #(= (:id %) (:id target)) columns) (:id target)) + _ (when (and (nil? aimed) (seq columns)) (rf/dispatch [::ui/aim-a-lane])) active (when (and (= sid (:sid @range-state)) (= clip-id (:clip-id @range-state))) @range-state) [ac af] (:anchor active) @@ -719,11 +765,16 @@ bottom (when active (max af bf)) lanes (when (and active (< right (count columns))) (mapv :id (subvec columns left (inc right)))) + ;; TWO DISPATCHES, BECAUSE THEY ARE TWO FACTS. Clicking a cell AIMS at + ;; the column's lane — that is where the next drawing goes — and SELECTS + ;; whatever is in the cell, which is what the inspector then shows. A + ;; gap selects the lane itself, there being nothing in it to inspect. choose! (fn [c f extend?] (reset! range-state {:sid sid :clip-id clip-id :anchor (if (and extend? active) (:anchor active) [c f]) :focus [c f]}) (rf/dispatch [::pb/seek f]) + (rf/dispatch [::ui/aim-at (:select (nth columns c))]) (rf/dispatch [::ui/select (or (get-in columns [c :cells f :cel :select]) (:select (nth columns c)))])) clear! #(when lanes @@ -758,6 +809,16 @@ cmd? (or (.-metaKey e) (.-ctrlKey e)) arrow (get {"arrowup" [0 -1] "arrowdown" [0 1] "arrowleft" [-1 0] "arrowright" [1 0]} k)] + (when (and (= "n" k) (not cmd?) aimed) + ;; THE ONE THING THE DELETED BUTTON DID THAT DRAWING CANNOT SAY. + ;; Drawing on an empty frame makes the drawing there, which covers + ;; every case but one: wanting the NEXT drawing when the playhead is + ;; not yet on an empty frame. `append-drawing` puts it past the end + ;; of the lane and seeks to it, so draw-N-draw-N keeps its rhythm + ;; without a trip to a menu. `lane-model.md` calls this one `N` too. + (.preventDefault e) + (.stopPropagation e) + (rf/dispatch [::ui/append-drawing])) (when (and lanes (or arrow (#{"delete" "backspace" "escape"} k) (and cmd? (#{"c" "x" "v"} k)))) (.preventDefault e) @@ -783,10 +844,19 @@ (str "Extend hold to frame " (dec (:end @gesture)) " · later cels move with it") "Drag to select · Shift extends · ⌘/Ctrl C/X/V · Delete clears · drag a hold’s corner to resize")] [:div.cs-head.cs-frame "frame"] - (doall (for [{:keys [path label select]} columns] + (doall (for [{:keys [path label select id]} columns] ^{:key (str "head-" path)} - [:button.cs-head {:class (when (= select selection) "selected") - :on-click #(rf/dispatch [::ui/select select])} + ;; A HEAD AIMS AND DOES NOT SELECT. Clicking a column's name says + ;; "drawings go here"; it is not a claim about anything to inspect, + ;; so the inspector keeps whatever cel it was showing. + [:button.cs-head {:class (str (when (= select selection) " selected") + (when (= id aimed) " aimed")) + :title (if (= id aimed) + (str label " · new drawings go here") + (str label " · aim new drawings here")) + :on-click #(rf/dispatch [::ui/aim-at select])} + ;; No name tag here, unlike the stage's outline: the thing the + ;; outline is around IS the name. A tag would repeat it. label])) (doall (for [f (range frames) @@ -831,7 +901,26 @@ (reset! gesture {:kind :hold :id id :column c :start (first span) :end (second span)})))}])]))))]))) +(defn- no-lanes + "What the cel sheet has to say about a symbol with nothing to show frames of. + + AN EMPTY GRID IS NOT AN ANSWER. The sheet is one column per lane, so a symbol + with no lane renders as a frame ruler and nothing beside it — which looks like + the view is broken rather than like the document is empty. The one thing + anybody can do from here is the one thing offered." + [] + [:div.cs-empty + [:p "This symbol has no drawing lanes."] + [:p.dim "The cel sheet shows one column per lane: frames down, drawings across."] + [:button {:on-click #(rf/dispatch [::ui/new-lane])} "make a drawing lane"]]) + (defn view [] (if (= :cel-sheet @(rf/subscribe [::sub/time-view])) - [:section.pane.time [transport] [cel-sheet-view]] + (let [clip @(rf/subscribe [::render/clip]) + open @(rf/subscribe [::render/open])] + [:section.pane.time + [transport] + (if (seq (symbol/lanes (get-in clip [:symbols open :nodes]))) + [cel-sheet-view] + [no-lanes])]) [timeline-view])) diff --git a/frontend/test/arthur/domain/gesture_test.cljs b/frontend/test/arthur/domain/gesture_test.cljs index f219c65..c87cd19 100644 --- a/frontend/test/arthur/domain/gesture_test.cljs +++ b/frontend/test/arthur/domain/gesture_test.cljs @@ -51,6 +51,19 @@ (drawn moved [u v :shape])) (str "moving " path " by (7, -4) on the stage moves the shape by (7, -4)"))))) +(deftest a-buffered-performance-take-becomes-one-set-of-authored-keys + (let [c (paint/new-shape (clip/blank) :main :shape 0 [0 0 10 0 5 10] :brow) + out (gesture/apply-take + c {[:main :shape] + {3 {[:xform :pos] [10 20] [:xform :rot] 0.25} + 4 {[:xform :pos] [12 22] [:xform :rot] 0.5}}})] + (is (= {3 [10 20], 4 [12 22]} + (get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :keys]))) + (is (= {3 0.25, 4 0.5} + (get-in out [:symbols :main :nodes :shape :channels [:xform :rot] :keys]))) + (is (= :linear + (get-in out [:symbols :main :nodes :shape :channels [:xform :pos] :interp]))))) + (deftest turning-keeps-the-pivot-where-it-is (let [c (two-down) path [u v :shape] diff --git a/frontend/test/arthur/domain/lane_test.cljs b/frontend/test/arthur/domain/lane_test.cljs index 9144dfb..b8290de 100644 --- a/frontend/test/arthur/domain/lane_test.cljs +++ b/frontend/test/arthur/domain/lane_test.cljs @@ -10,6 +10,7 @@ [arthur.domain.palette :as pal] [arthur.domain.pick :as pick] [arthur.domain.lane :as lane] + [arthur.domain.span :as span] [arthur.domain.symbol :as symbol])) (defn drawing [id x frames] @@ -410,44 +411,10 @@ {:at 4 :extent :grow-symbol}) [:clip :symbols :main :nodes :n])))))) -(deftest splitting-an-cel-changes-nothing-that-is-drawn - (let [doc (document) - fs (range 12) - before (drawn doc fs)] - (doseq [[label id cut] [["a held drawing" :a 2] - ["a cel with a correction of its own" :b 6] - ["a playing insert" :insert 10]]] - (testing label - (let [r (lane/split doc :main id cut :right) - after (:clip r)] - (is (= :right (:selection r))) - (is (= before (drawn after fs)) "the same picture, frame for frame") - (is (= (node/placed-span (get-in doc [:symbols :main :nodes id])) - [(first (node/placed-span (get-in after [:symbols :main :nodes id]))) - (second (node/placed-span (get-in after [:symbols :main :nodes :right])))]) - "the pieces occupy the frames the cel did") - (is (= cut (second (node/placed-span (get-in after [:symbols :main :nodes id]))) - (first (node/placed-span (get-in after [:symbols :main :nodes :right]))))) - (is (= (:time (get-in doc [:symbols :main :nodes id])) - (:time (get-in after [:symbols :main :nodes :right]))) - "one time map, so the right piece's own frames carry on") - (is (= (select-keys (get-in doc [:symbols :main :nodes id]) [:source :playback :channels]) - (select-keys (get-in after [:symbols :main :nodes :right]) [:source :playback :channels]))) - (is (= 12 (get-in after [:symbols :main :frames])) "and no shot-length question") - (is (empty? (clip/problems after)))))))) - -(deftest split-refuses-anything-that-is-not-one-cut-inside-one-cel - (let [doc (document)] - (doseq [cut [0 4 8 12 -1 2.5 ##NaN nil]] - (is (:refused (lane/split doc :main :b cut :right)) (str "cut at " (pr-str cut)))) - (is (:refused (lane/split doc :main :girl 2 :right)) "a lane is not a cel") - (is (:refused (lane/split doc :main :plate 2 :right)) "nor is a shape outside one") - (is (:refused (lane/split doc :main :a 2 :b)) "the new ID has to be free"))) - (deftest split-then-place-puts-a-drawing-inside-a-hold ;; The two commands the doc asks for, composed: neither one guesses. (let [doc (document) - cut (:clip (lane/split doc :main :a 2 :right)) + cut (:clip (span/split doc :main :a 2 :right)) r (lane/append-drawing cut :main :girl :n :drawing-n {:at 2 :extent :grow-symbol}) after (:clip r)] @@ -519,65 +486,6 @@ (defn- spans [clip ids] (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) -(deftest trimming-narrows-one-cel-and-moves-nothing-else - (let [doc (document) - r (lane/trim doc :main :b :out 6) - after (:clip r)] - (is (= [[0 4] [4 6] [8 12]] (spans after [:a :b :insert]))) - (is (= :b (:selection r))) - (is (= (select-keys (get-in doc [:symbols :main :nodes :b]) [:time :playback :channels :source]) - (select-keys (get-in after [:symbols :main :nodes :b]) [:time :playback :channels :source])) - "only :span changed") - (is (= 12 (get-in after [:symbols :main :frames]))) - (is (empty? (clip/problems after))))) - -(deftest trimming-the-front-of-a-playing-insert-does-not-restart-it - ;; The difference between trimming and slipping. Its own frames are where they - ;; were, so the frames that survive show exactly what they showed. - (let [doc (document) - before (sample doc [10 11]) - after (:clip (lane/trim doc :main :insert :in 10))] - (is (= [10 12] (node/placed-span (get-in after [:symbols :main :nodes :insert])))) - (is (= (:playback (get-in doc [:symbols :main :nodes :insert])) - (:playback (get-in after [:symbols :main :nodes :insert])))) - (is (= before (sample after [10 11])) "the same animation on the frames it kept") - ;; And the frames it gave up show nothing of it. - (is (= #{:plate} (set (keys (get (sample after [9]) 9))))))) - -(deftest trim-refuses-to-lengthen-or-to-land-on-an-edge - (let [doc (document)] - (doseq [[label edge to] [["at its own start" :in 4] - ["at its own end" :out 8] - ["past its end" :out 9] - ["before its start" :in 2] - ["off a whole frame" :out 5.5]]] - (is (:refused (lane/trim doc :main :b edge to)) label)) - (is (:refused (lane/trim doc :main :b :middle 6))) - (is (:refused (lane/trim doc :main :girl :out 6)) "a lane is not a cel"))) - -(deftest moving-an-cel-keeps-its-length-and-its-source-origin - (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) - r (lane/move doc :main :insert 4) - after (:clip r)] - (is (= [[0 4] [4 8]] (spans after [:a :insert]))) - (is (= :insert (:selection r))) - (is (= (:playback (get-in doc [:symbols :main :nodes :insert])) - (:playback (get-in after [:symbols :main :nodes :insert])))) - ;; It began on source frame 3 at lane 8; it begins on source frame 3 at lane 4. - (is (= (get-in (sample doc [8]) [8 [:insert :mark]]) - (get-in (sample after [4]) [4 [:insert :mark]]))) - (is (empty? (clip/problems after))))) - -(deftest a-move-onto-an-occupied-frame-is-refused-rather-than-rippled - (let [doc (document)] - (is (:refused (lane/move doc :main :insert 6)) "it would overlap B") - (is (:refused (lane/move doc :main :insert 4.5))) - (is (:refused (lane/move doc :main :girl 2))) - ;; Clearing the room first is the composition, and then it goes. - (let [cleared (:clip (lane/blank doc :main :girl [4 8] {}))] - (is (= [[0 4] [4 8]] (spans (:clip (lane/move cleared :main :insert 4)) - [:a :insert])))))) - (deftest blanking-leaves-a-gap-and-does-not-close-it (let [doc (document) r (lane/blank doc :main :girl [5 7] {:id :rest}) @@ -648,6 +556,6 @@ (is (= 21 (get-in (lane/append-drawing empty-lane :main :girl :n :drawing-n {:at 20 :extent :grow-symbol}) [:clip :symbols :main :frames]))) - (is (= 12 (get-in (:clip (lane/trim doc :main :insert :out 9)) + (is (= 12 (get-in (:clip (span/trim doc :main :insert :out 9)) [:symbols :main :frames])) "and trimming the last cel leaves the window where it was"))) diff --git a/frontend/test/arthur/domain/node_test.cljs b/frontend/test/arthur/domain/node_test.cljs index c7cc882..5c19862 100644 --- a/frontend/test/arthur/domain/node_test.cljs +++ b/frontend/test/arthur/domain/node_test.cljs @@ -216,3 +216,13 @@ (let [d (node/toggle-key (node/set-segment-interp c [:xform :pos] 0 :hold) [:xform :pos] 0 nil)] (is (not (contains? (get-in d [:channels [:xform :pos] :segments]) 0)) "taking a key off takes its gap's choice with it")))) + +(deftest auto-keying-a-channel-from-a-parameter-edit + (let [n {:id :x :kind :group} + keyed (node/set-keyed-channel n [:xform :rot] 7 1.25) + moved (node/set-keyed-channel keyed [:xform :rot] 11 2.5) + visible (node/set-keyed-channel n [:vis] 7 false)] + (is (= {7 1.25, 11 2.5} (get-in moved [:channels [:xform :rot] :keys]))) + (is (= :linear (get-in moved [:channels [:xform :rot] :interp]))) + (is (= :hold (get-in visible [:channels [:vis] :interp])) + "boolean parameters do not tween"))) diff --git a/frontend/test/arthur/domain/span_test.cljs b/frontend/test/arthur/domain/span_test.cljs new file mode 100644 index 0000000..b9c8c32 --- /dev/null +++ b/frontend/test/arthur/domain/span_test.cljs @@ -0,0 +1,223 @@ +(ns arthur.domain.span-test + "Split, trim and move, over the two things they have to work on alike: a cel + inside a lane, and a symbol placed straight into a shot. The fixture carries + both on purpose — the commands were lane-gated for as long as a lane was the + only thing anybody had timed, and the point of these tests is that nothing in + them reads a lane." + (:require [cljs.test :refer [deftest is testing]] + [arthur.domain.channel :as ch] + [arthur.domain.clip :as clip] + [arthur.domain.lane :as lane] + [arthur.domain.node :as node] + [arthur.domain.palette :as pal] + [arthur.domain.span :as span])) + +(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- cel [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 + "A lane of three cels, and — the part lane_test's fixture has no equivalent of + — `:badge`, an instance of an animated symbol placed straight into `:main` + with a span of its own and no parent at all. Its frames are the SYMBOL's, so + it is the case where the coordinate a command takes is not lane time." + [] + (let [a (cel :a :drawing-a 0 4 0) + b (cel :b :drawing-b 4 4 0) + insert (assoc-in (cel :insert :wave 8 4 1) [:playback :in] 3)] + {:name "spans" :fps 24 :width 320 :height 200 + :symbols + {:main {:id :main :frames 12 + :nodes {:girl {:id :girl :kind :group :layout :sequence :z "b"} + :a a :b b :insert insert + :badge {:id :badge :kind :instance :z "c" + :source {:symbol :wave} + :playback {:in 0 :speed 1 :end :stop} + :time {:at 2 :rate 1} :span [0 8]} + :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))) + +(defn- drawn [doc fs] + (let [at (sample doc fs)] + (mapv #(sort (vals (get at %))) fs))) + +(defn- spans [clip ids] + (mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) ids)) + +(deftest the-fixture-places-one-thing-outside-the-lane + (let [doc (document)] + (is (empty? (clip/problems doc))) + (is (nil? (:parent (get-in doc [:symbols :main :nodes :badge]))) + "so a command acting on it has only the symbol's frames to go by") + (is (= [2 10] (node/placed-span (get-in doc [:symbols :main :nodes :badge])))))) + +;; --------------------------------------------------------------------------- +;; split + +(deftest splitting-changes-nothing-that-is-drawn + (let [doc (document) + fs (range 12) + before (drawn doc fs)] + (doseq [[label id cut] [["a held drawing in a lane" :a 2] + ["a playing insert in a lane" :insert 10] + ["a placement with no lane at all" :badge 6]]] + (testing label + (let [r (span/split doc :main id cut :right) + after (:clip r)] + (is (= :right (:selection r))) + (is (= before (drawn after fs)) "the same picture, frame for frame") + (is (= (node/placed-span (get-in doc [:symbols :main :nodes id])) + [(first (node/placed-span (get-in after [:symbols :main :nodes id]))) + (second (node/placed-span (get-in after [:symbols :main :nodes :right])))]) + "the pieces occupy the frames the one node did") + (is (= cut (second (node/placed-span (get-in after [:symbols :main :nodes id]))) + (first (node/placed-span (get-in after [:symbols :main :nodes :right]))))) + (is (= (:time (get-in doc [:symbols :main :nodes id])) + (:time (get-in after [:symbols :main :nodes :right]))) + "one time map, so the right piece's own frames carry on") + (is (= (select-keys (get-in doc [:symbols :main :nodes id]) + [:source :playback :channels :parent :z]) + (select-keys (get-in after [:symbols :main :nodes :right]) + [:source :playback :channels :parent :z])) + "and it keeps its parent and its depth, so it draws where it drew") + (is (= 12 (get-in after [:symbols :main :frames])) "and no shot-length question") + (is (empty? (clip/problems after)))))))) + +(deftest split-refuses-anything-but-one-cut-inside-one-thing + (let [doc (document)] + (doseq [cut [0 4 8 12 -1 2.5 ##NaN nil]] + (is (:refused (span/split doc :main :b cut :right)) (str "cut at " (pr-str cut)))) + (is (:refused (span/split doc :main :a 2 :b)) "the new ID has to be free") + (is (:refused (span/split doc :main :missing 2 :right))) + (is (re-find #"group" (:refused (span/split doc :main :girl 2 :right))) + "a group is divided by its children, not by its span") + (is (re-find #"whole shot" (:refused (span/split doc :main :plate 2 :right))) + "and a node with no span has no edges to cut"))) + +;; --------------------------------------------------------------------------- +;; trim + +(deftest trimming-narrows-one-thing-and-moves-nothing-else + (let [doc (document)] + (doseq [[label id edge to kept] [["a cel in a lane" :b :out 6 [4 6]] + ["a placement outside one" :badge :out 7 [2 7]] + ["the front of one outside a lane" :badge :in 5 [5 10]]]] + (testing label + (let [r (span/trim doc :main id edge to) + after (:clip r)] + (is (= kept (node/placed-span (get-in after [:symbols :main :nodes id])))) + (is (= id (:selection r))) + (is (= (select-keys (get-in doc [:symbols :main :nodes id]) + [:time :playback :channels :source]) + (select-keys (get-in after [:symbols :main :nodes id]) + [:time :playback :channels :source])) + "only :span changed") + (is (= [[0 4] [8 12]] (spans after [:a :insert])) "and no neighbour moved") + (is (= 12 (get-in after [:symbols :main :frames]))) + (is (empty? (clip/problems after)))))))) + +(deftest trimming-the-front-does-not-restart-what-is-playing + ;; The difference between trimming and slipping, asserted on the node that has + ;; no lane: its own frames are where they were, so the frames that survive + ;; show exactly what they showed. + (let [doc (document) + before (sample doc [6 7]) + after (:clip (span/trim doc :main :badge :in 6))] + (is (= [6 10] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) + (is (= (:playback (get-in doc [:symbols :main :nodes :badge])) + (:playback (get-in after [:symbols :main :nodes :badge])))) + (is (= (get-in before [6 [:badge :mark]]) + (get-in (sample after [6]) [6 [:badge :mark]])) + "the same animation on the frames it kept") + (is (nil? (get-in (sample after [5]) [5 [:badge :mark]])) + "and the frames it gave up show nothing of it"))) + +(deftest trim-refuses-to-lengthen-or-to-land-on-an-edge + (let [doc (document)] + (doseq [[label id edge to] [["at its own start" :b :in 4] + ["at its own end" :b :out 8] + ["past its end" :b :out 9] + ["before its start" :b :in 2] + ["off a whole frame" :b :out 5.5] + ["past the end of one outside a lane" :badge :out 11] + ["before the start of one outside a lane" :badge :in 1]]] + (is (:refused (span/trim doc :main id edge to)) label)) + (is (:refused (span/trim doc :main :b :middle 6))) + (is (re-find #"group" (:refused (span/trim doc :main :girl :out 6)))))) + +;; --------------------------------------------------------------------------- +;; move + +(deftest moving-keeps-its-length-and-its-source-origin + (let [doc (update-in (document) [:symbols :main :nodes] dissoc :b) + r (span/move doc :main :insert 4) + after (:clip r)] + (is (= [[0 4] [4 8]] (spans after [:a :insert]))) + (is (= :insert (:selection r))) + (is (= (:playback (get-in doc [:symbols :main :nodes :insert])) + (:playback (get-in after [:symbols :main :nodes :insert])))) + ;; It began on source frame 3 at lane 8; it begins on source frame 3 at lane 4. + (is (= (get-in (sample doc [8]) [8 [:insert :mark]]) + (get-in (sample after [4]) [4 [:insert :mark]]))) + (is (empty? (clip/problems after))))) + +(deftest a-move-outside-a-lane-is-free-to-land-on-an-occupied-frame + ;; The non-overlap rule is the LANE's, and `:badge` is not in one. Things + ;; placed in a composition are allowed to be on screen together, so there is + ;; nothing here for a move to refuse. + (let [doc (document) + r (span/move doc :main :badge 0) + after (:clip r)] + (is (= [0 8] (node/placed-span (get-in after [:symbols :main :nodes :badge])))) + (is (= [[0 4] [4 8] [8 12]] (spans after [:a :b :insert])) + "and the lane beside it did not notice") + (is (= (get-in (sample doc [2]) [2 [:badge :mark]]) + (get-in (sample after [0]) [0 [:badge :mark]])) + "its source origin came with it") + (is (empty? (clip/problems after))))) + +(deftest a-move-onto-an-occupied-frame-of-a-lane-is-refused-rather-than-rippled + (let [doc (document)] + (is (:refused (span/move doc :main :insert 6)) "it would overlap B") + (is (:refused (span/move doc :main :insert 4.5))) + (is (re-find #"group" (:refused (span/move doc :main :girl 2)))) + (is (re-find #"whole shot" (:refused (span/move doc :main :plate 2)))) + ;; Clearing the room first is the composition, and then it goes. + (let [cleared (:clip (lane/blank doc :main :girl [4 8] {}))] + (is (= [[0 4] [4 8]] (spans (:clip (span/move cleared :main :insert 4)) + [:a :insert])))))) + +;; --------------------------------------------------------------------------- +;; the coordinate + +(deftest host-frame-reads-lane-time-for-a-cel-and-symbol-time-for-everything-else + (let [doc (document) + retimed (assoc-in doc [:symbols :main :nodes :girl :time] {:at 4 :rate 2})] + (is (= 6 (span/host-frame doc :main :b 6)) + "an untimed lane reads the symbol's frames as its own") + (is (= 6 (span/host-frame doc :main :badge 6)) + "and so does a node with no parent, always") + (is (= 4 (span/host-frame retimed :main :b 6)) + "through a lane at :at 4 :rate 2, symbol frame 6 is lane frame 4") + (is (= 6 (span/host-frame retimed :main :badge 6)) + "which is the lane's business and not the badge's") + (is (nil? (span/host-frame (assoc-in doc [:symbols :main :nodes :girl :time] + {:loop? true}) + :main :b 6)) + "and a looping parent has no single answer to give"))) diff --git a/frontend/test/arthur/events/lane_test.cljs b/frontend/test/arthur/events/lane_test.cljs index e489d8b..f751f78 100644 --- a/frontend/test/arthur/events/lane_test.cljs +++ b/frontend/test/arthur/events/lane_test.cljs @@ -1,11 +1,13 @@ (ns arthur.events.lane-test (:require [cljs.test :refer [deftest is]] [arthur.domain.lane-test :as fixture] + [arthur.domain.clip :as clip] [arthur.domain.correction :as correction] [arthur.domain.lane :as lane] [arthur.events.ui :as ui] [arthur.domain.history :as history] [arthur.domain.leaf :as leaf] + [arthur.domain.symbol :as symbol] [arthur.footage.store :as store] [arthur.ui.timeline :as timeline])) @@ -47,6 +49,95 @@ (is (= 12 (ui/selection-frame doc nil :main [:node :main :a [:a]] 12))))) +(deftest polygon-landing-follows-the-target-not-the-selection + (let [doc (fixture/document) + db {:ui {:open :main + :time-view :timeline + :selection [:node :main :plate [:plate]] + :target {:sid :main :id :insert :path [:insert]}} + :playback {:frame 5}} + landing (ui/polygon-landing doc {} db)] + (is (= doc (:clip landing))) + (is (= [:insert] (:path landing)) + "looking at another shape does not silently move the creation target") + (is (false? (:lane? landing))))) + +(deftest cel-sheet-polygon-landing-is-decided-by-the-aimed-lane + (let [doc (fixture/document) + base {:ui {:open :main + :time-view :cel-sheet + :selection [:node :main :plate [:plate]] + :target {:sid :main :id :girl :path [:girl]}} + :playback {:frame 5}} + occupied (ui/polygon-landing doc {} base) + with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest})) + gap (ui/polygon-landing with-gap {} (assoc-in base [:playback :frame] 6))] + (is (= [:b] (:path occupied)) + "the cel on screen wins even while an unrelated stage node is selected") + (is (= doc (:clip occupied)) "an existing cel needs no document edit") + (is (true? (:lane? occupied))) + (is (= 1 (count (:path gap)))) + (is (not (contains? (get-in with-gap [:symbols :main :nodes]) + (first (:path gap)))) + "a gap receives a fresh drawing") + (is (contains? (get-in (:clip gap) [:symbols :main :nodes]) + (first (:path gap)))) + (is (empty? (clip/problems (:clip gap)))))) + +(deftest cel-sheet-polygon-landing-refuses-without-an-aimed-lane + (let [doc (fixture/document) + db {:ui {:open :main :time-view :cel-sheet + :target {:sid :main :id :plate :path [:plate]}} + :playback {:frame 5}} + landing (ui/polygon-landing doc {} db)] + (is (re-find #"drawing lane" (:refused landing))) + (is (true? (:lane? landing))) + (is (nil? (:clip landing))))) + +(deftest beginning-a-polygon-materializes-a-missing-cel-sheet-drawing + (let [doc (fixture/document) + with-gap (:clip (lane/blank doc :main :girl [5 7] {:id :rest})) + id (store/install! {:clip with-gap :store {}} "polygon-start-test") + db {:clip/current id :paint/revision 0 + :ui {:open :main :time-view :cel-sheet + :target {:sid :main :id :girl :path [:girl]}} + :playback {:frame 6}} + after (ui/beginning-polygon db) + saved (:clip (store/entry (:clip/current after))) + [_ sid cel-id path] (get-in after [:ui :selection])] + (is (= :polygon (get-in after [:ui :tool]))) + (is (= [] (get-in after [:ui :draft]))) + (is (= :main sid)) + (is (= [cel-id] path)) + (is (contains? (get-in saved [:symbols :main :nodes]) cel-id) + "the drawing exists before the first draft point is added") + (is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at]))) + (is (empty? (clip/problems saved))))) + +(deftest beginning-a-polygon-materializes-a-lane-before-its-drawing + (let [doc (clip/blank) + id (store/install! {:clip doc :store {}} "polygon-lane-start-test") + db {:clip/current id :paint/revision 0 + :ui {:open :main :time-view :cel-sheet} + :playback {:frame 6}} + after (ui/beginning-polygon db) + saved (:clip (store/entry (:clip/current after))) + lanes (symbol/lanes (get-in saved [:symbols :main :nodes])) + lane-id (:id (first lanes)) + [_ sid cel-id path] (get-in after [:ui :selection])] + (is (= :polygon (get-in after [:ui :tool]))) + (is (= 1 (count lanes))) + (is (= {:sid :main :id lane-id :path [lane-id]} + (get-in after [:ui :target]))) + (is (= :main sid)) + (is (= [cel-id] path)) + (is (= lane-id (get-in saved [:symbols :main :nodes cel-id :parent]))) + (is (= 6 (get-in saved [:symbols :main :nodes cel-id :time :at]))) + (is (= 1 (count (get-in (store/entry (:clip/current after)) + [:history :done]))) + "the lane and drawing are one start-polygon undo step") + (is (empty? (clip/problems saved))))) + (deftest sequence-commands-use-isolated-history-transactions (let [doc (fixture/document) id (store/install! {:clip doc :store {}} "sequence-test") diff --git a/static/arthur/app.css b/static/arthur/app.css index bf85903..3adc3c1 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -40,6 +40,26 @@ --sel: #2f6fc0; --sel-bg: #cfe0f5; + /* A SECOND accent, and the one exception to the rule above — stated here + because SELECTED and AIMED are two different facts that are often true of + one node at the same time, and one accent cannot say both. + Selected is what you are LOOKING at: the inspector's subject, the thing + with handles on it. Aimed is where a new drawing or symbol would GO. They + used to be the same state, which is how drawing a polygon ended up in + whatever you had last clicked on the stage. + Violet rather than another blue: in the chrome it has to be told apart + from --sel, and on the stage from the warm gold the handles are drawn in. + Colour is not the only channel either — the aim outline is SOLID where the + selection's box is dashed, and it carries no handles at all, because there + is nothing about being aimed at that you could drag. --aim-stage is the + same hue lifted to read against --stage, which is the one dark surface. */ + --aim: #8d4bd6; + --aim-stage: #c79bf2; + + /* Auto-key is a recording state, distinct from selection and aiming. */ + --live: #239447; + --live-bg: #e2f5e7; + /* A keyframe is a dot and a dot is ink. Flash draws them black and so does this; the frames a node exists over are a pale tint behind them. */ --key: #1f1f1f; @@ -732,6 +752,13 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } border-bottom: 1px solid var(--line); } +.palette-bar .auto-key.on { + color: #145c2b; + background: var(--live-bg); + border-color: var(--live); + box-shadow: 0 0 7px rgba(35, 148, 71, .72), inset 0 0 0 1px rgba(255, 255, 255, .7); +} + .swatches { display: flex; gap: 3px; } /* Circles. A palette entry is one indivisible tone, not an area of coverage, and @@ -1161,6 +1188,26 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .cs-cell:hover { background: var(--sel-bg); } .cs-cell.selected { background: var(--sel-bg); color: var(--sel); font-weight: 600; } .cs-head.selected { background: var(--sel-bg); color: var(--sel); } + +/* AIMED COMPOSES WITH SELECTED rather than replacing it: the ring is the aim, + the tint is the selection, and a row that is both wears both. No name tag in + the chrome — the thing the ring is around is already the name. */ +.tl-label.aimed, +.cs-head.aimed { box-shadow: inset 0 0 0 2px var(--aim); } +.cs-head.aimed { color: var(--aim); } + +.cs-empty { + display: grid; + justify-items: center; + align-content: center; + gap: 6px; + padding: 28px 16px; + background: var(--pane); + text-align: center; +} +.cs-empty p { margin: 0; } +.cs-empty .dim { color: var(--dim); font-size: 11px; } +.cs-empty button { margin-top: 4px; } .cel-sheet { user-select: none; touch-action: none; } .cs-cell { position: relative; } .cs-cell:focus-visible { outline: 2px solid var(--sel); outline-offset: -2px; } @@ -1247,6 +1294,14 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .facts dd.channel .key { padding: 0 3px; color: var(--dim); } .facts dd.channel .key.keyed { color: var(--fg); } .facts dd.channel .key.on { color: var(--sel); } +.facts dd.channel.live { + margin: -2px; + padding: 2px; + border-radius: 3px; + background: var(--live-bg); + box-shadow: 0 0 0 1px rgba(35, 148, 71, .45), 0 0 6px rgba(35, 148, 71, .28); +} +.facts dd.channel.live input { border-color: var(--live); } /* The selected node's transform box, in stage pixels (the SVG's viewBox). */ .paint-overlay .handles .box { fill: none; stroke: #e6ca8b; stroke-width: 0.5; stroke-dasharray: 2 1; pointer-events: none; } @@ -1254,4 +1309,17 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } .paint-overlay .handles .knob { fill: #161820; stroke: #fff1be; stroke-width: 0.6; cursor: grab; } .paint-overlay .handles .corner { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: nwse-resize; } .paint-overlay .handles .pivot { stroke: #fff1be; stroke-width: 0.6; pointer-events: none; } + +/* The aim outline and its name tag. Solid, no handles, and a tag pinned just + outside the bottom-right corner — see `ui/stage/aim-box` for why the box + rotates with the node and the tag does not. Sizes are in user units because + this SVG's viewBox is the stage's 320x200 scaled by `zoom`. */ +.paint-overlay .aim { pointer-events: none; } +.paint-overlay .aim .aim-box { fill: none; stroke: var(--aim-stage); stroke-width: 0.7; } +.paint-overlay .aim .aim-tag-bg { fill: var(--aim-stage); } +.paint-overlay .aim .aim-tag { + fill: #1b1030; + font: 600 3.4px ui-sans-serif, system-ui, sans-serif; + letter-spacing: 0.04px; +} .paint-overlay:focus { outline: none; }