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

The cel sheet creates the place a polygon needs

Browse source
This commit is contained in:
Your Name 2026-10-01 12:17:35 -04:00
parent 6443366748
commit 3879d76d57
12 changed files with 1180 additions and 441 deletions
Download patch file Download diff file Expand all files Collapse all files

198
frontend/src/arthur/domain/lane.cljs
View file

@ -1,11 +1,19 @@
(ns arthur.domain.lane (ns arthur.domain.lane
"The commands over a lane of cels: make one, put drawings in it, change "The commands that need a SEQUENCE: make a lane, put drawings in it, change
how long they are exposed, and decide which of them share content. 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 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 node map: a group with `:layout :sequence`, whose children are non-overlapping
visual cels. This namespace only changes them. 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 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 `{: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 `clip/problems` would reject. A command that cannot say what the person meant
@ -20,76 +28,9 @@
(:require [arthur.domain.bring :as bring] (:require [arthur.domain.bring :as bring]
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol])) [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 (defn extend-hold
"Change one held cel's duration by `delta` lane frames and ripple its "Change one held cel's duration by `delta` lane frames and ripple its
later siblings. Lane channels, cel channels and source clocks stay put. later siblings. Lane channels, cel channels and source clocks stay put.
@ -100,7 +41,7 @@
lane (get nodes (:parent n)) lane (get nodes (:parent n))
rate (:rate (node/time-of n)) rate (:rate (node/time-of n))
span (:span n) span (:span n)
m (when lane (lane-map nodes (:id lane))) m (when lane (symbol/frame-map nodes (:id lane)))
;; The LANE's own shape, not the whole symbol's: refusing a cel ;; The LANE's own shape, not the whole symbol's: refusing a cel
;; edit over some unrelated defect elsewhere in the symbol would be ;; edit over some unrelated defect elsewhere in the symbol would be
;; this command answering for a part of the document it never touches. ;; this command answering for a part of the document it never touches.
@ -120,90 +61,7 @@
nodes (reduce (fn [ns sibling] nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) delta)) (update-in ns [(:id sibling) :time :at] (fnil + 0) delta))
nodes later)] nodes later)]
(finish clip sid nodes id extent))))) (span/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))))))
(defn blank (defn blank
"Clear lane frames `[a b)` of lane `lane-id`, leaving a GAP. "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 closes the hole — the cels after it stay where they are, because
emptying frames and re-timing a performance are different intentions. 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 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 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 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 (or (<= hi a) (>= lo b)) ns
(and (< lo a) (> hi b)) (and (< lo a) (> hi b))
(-> ns (-> ns
(assoc (:id n) (edged n :out a)) (assoc (:id n) (span/edged n :out a))
(assoc id (assoc (edged n :in b) :id id :z (str "a-" id)))) (assoc id (assoc (span/edged n :in b) :id id :z (str "a-" id))))
(and (>= lo a) (<= hi b)) (dissoc ns (:id n)) (and (>= lo a) (<= hi b)) (dissoc ns (:id n))
(< lo a) (assoc ns (:id n) (edged n :out a)) (< lo a) (assoc ns (:id n) (span/edged n :out a))
:else (assoc ns (:id n) (edged n :in b))))) :else (assoc ns (:id n) (span/edged n :in b)))))
nodes members)] 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 (defn sheet-range
"Snapshot a rectangle in open-symbol frames. Cel-local clocks and channels "Snapshot a rectangle in open-symbol frames. Cel-local clocks and channels
@ -253,7 +111,7 @@
(let [nodes (get-in clip [:symbols sid :nodes])] (let [nodes (get-in clip [:symbols sid :nodes])]
(if-not (and (seq lanes) (integer? a) (integer? b) (<= 0 a) (< a b) (if-not (and (seq lanes) (integer? a) (integer? b) (<= 0 a) (< a b)
(every? #(and (node/lane? (get nodes %)) (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"} {:refused "range editing requires lanes with the same clock as the sheet"}
{:duration (- b a) {:duration (- b a)
:columns :columns
@ -262,8 +120,8 @@
:let [[lo hi] (node/placed-span n)] :let [[lo hi] (node/placed-span n)]
:when (and (< lo b) (> hi a))] :when (and (< lo b) (> hi a))]
(-> n (-> n
(edged :in (max a lo)) (span/edged :in (max a lo))
(edged :out (min b hi)) (span/edged :out (min b hi))
(update-in [:time :at] (fnil - 0) a))))) lanes)}))) (update-in [:time :at] (fnil - 0) a))))) lanes)})))
(defn paste-range (defn paste-range
@ -292,7 +150,7 @@
(assoc :id cid :parent id :z (str "a-" cid)) (assoc :id cid :parent id :z (str "a-" cid))
(update-in [:time :at] + at))))) (update-in [:time :at] + at)))))
(get-in (:clip cleared) [:symbols sid :nodes]) cels) (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)))] problems (when (:clip result) (clip/problems (:clip result)))]
(if (seq problems) {:refused (first problems)} result)))))) (if (seq problems) {:refused (first problems)} result))))))
{:clip clip :selection (first lanes)} {: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 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." lane and there is no single answer to give a command."
[clip sid lane-id f] [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)))) (* rate (- f at))))
(defn- lane-end (defn- lane-end
@ -358,8 +216,8 @@
nodes (reduce (fn [ns sibling] nodes (reduce (fn [ns sibling]
(update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo))) (update-in ns [(:id sibling) :time :at] (fnil + 0) (- hi lo)))
(assoc nodes id n) later) (assoc nodes id n) later)
result (finish clip sid nodes id extent) result (span/finish clip sid nodes id extent)
m (lane-map nodes lane-id)] m (symbol/frame-map nodes lane-id)]
(cond-> result (cond-> result
(:clip result) (assoc :frame (+ (:at m) (/ at (:rate m))))))) (:clip result) (assoc :frame (+ (:at m) (/ at (:rate m)))))))
@ -381,7 +239,7 @@
(not (or (= :end at) (and (integer? at) (not (neg? at))))) (not (or (= :end at) (and (integer? at) (not (neg? at)))))
"a position is :end or a whole lane frame" "a position is :end or a whole lane frame"
inside (str "frame " at " is inside a cel; split it first") 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))))) :else (first (symbol/lane-problems nodes)))))
(defn append-drawing (defn append-drawing
@ -468,7 +326,7 @@
(or (= id remainder-id) (contains? nodes remainder-id)) (or (= id remainder-id) (contains? nodes remainder-id))
"the remainder cel needs a free ID different from the new cel" "the remainder cel needs a free ID different from the new cel"
(clip/symbol clip drawing-id) "the new drawing ID is already used" (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")] "drawing creation through a stepped or looping lane is not supported")]
{:refused why} {:refused why}
(let [cleared (blank clip sid lane-id [at (inc at)] {:id remainder-id})] (let [cleared (blank clip sid lane-id [at (inc at)] {:id remainder-id})]

192
frontend/src/arthur/domain/span.cljs Normal file
View file

@ -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))))))

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

@ -102,6 +102,46 @@
(sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %)))) (sort-by (juxt #(or (first (node/placed-span %)) 0) #(str (:id %))))
vec)) 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 (defn lane-problems
"What makes a lane not a lane. A SEQUENCE is the one composition rule the node "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 map carries — ordinary groups compose freely — so it is checked here, beside

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

@ -1,6 +1,19 @@
(ns arthur.events.ui (ns arthur.events.ui
"Selection, the active tone, the polygon being drawn, and which timeline rows "Selection, the TARGET, the active tone, the polygon being drawn, and which
are open. 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 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 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.nest :as nest]
[arthur.domain.node :as node] [arthur.domain.node :as node]
[arthur.domain.lane :as lane] [arthur.domain.lane :as lane]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol]
[arthur.events.edit :as edit] [arthur.events.edit :as edit]
[arthur.events.paint :as paint] [arthur.domain.paint :as paint]
[arthur.events.playback :as playback] [arthur.events.playback :as playback]
[arthur.footage.store :as store] [arthur.footage.store :as store]
[re-frame.core :as rf])) [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 (rf/reg-event-db
::select ::aim
;; The rows above a selection are opened, so one made deep on the stage is ;; The gestures that name a PLACE in the document rather than a thing on
;; seen in the timeline. Not a sound's: its row is always in the audio section, ;; screen: a timeline row label, a cel-sheet column, a breadcrumb.
;; and opening the placement it is heard through would bury it. (fn [db [_ selection]] (aimed db selection)))
(fn [db [_ selection]]
(let [[kind sid id path] selection (rf/reg-event-db
sound? (= :audio (get-in (store/entry (:clip/current db)) ::aim-at
[:clip :symbols sid :nodes id :kind]))] ;; Aiming without selecting, for the cel sheet: the lane becomes where drawings
(cond-> (-> db ;; go, and what is SELECTED stays whatever cel the sheet picked in it.
(assoc-in [:ui :selection] selection) (fn [db [_ selection]] (assoc-in db [:ui :target] (target-of selection))))
(update :ui dissoc :points :lane-retry))
(and (= :node kind) path (not sound?))
(update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))))
(rf/reg-event-db (rf/reg-event-db
::set-tone ::set-tone
(fn [db [_ tone]] (assoc-in db [:ui :tone] 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 (rf/reg-event-db
::set-time-view ::set-time-view
(fn [db [_ view]] (fn [db [_ view]]
(if (#{:timeline :cel-sheet} 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))) 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 (defn apply-lane-command
"Commit a successful domain command as one history step. A refused 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." leaves the document and history untouched; an overflow offers an explicit retry."
@ -92,10 +174,16 @@
(rf/reg-event-db (rf/reg-event-db
::new-lane ::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 _] (fn [db _]
(let [clip (:clip (store/entry (:clip/current db))) (let [clip (:clip (store/entry (:clip/current db)))
sid (get-in db [:ui :open])] sid (get-in db [:ui :open])
(apply-lane-command db sid (lane/add-lane clip sid (random-uuid)) nil)))) 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 (defn- committed
"One appending command, as effects: commit it, and look at what it made. "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"})] {:refused "this lane's frames are not the open symbol's"})]
(committed db sid result [::insert-drawing :grow-symbol])))) (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 (defn- at-playhead
"The selected cel, its lane, and the playhead as a frame of that lane's "The selected node and the playhead as a frame of the space that node is
own time — or a refusal in place of the frame where there is no single one." 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] [db]
(let [{clip :clip st :store} (store/entry (:clip/current db)) (let [{clip :clip st :store} (store/entry (:clip/current db))
selection (get-in db [:ui :selection]) selection (get-in db [:ui :selection])
[_ sid id] selection [_ sid id] selection]
n (get-in clip [:symbols sid :nodes id])] {:clip clip :sid sid :id id
{:clip clip :sid sid :id id :node n :node (get-in clip [:symbols sid :nodes id])
:at (when-let [owner-frame (selection-frame clip st (get-in db [:ui :open]) selection :at (when-let [owner-frame (selection-frame clip st (get-in db [:ui :open]) selection
(get-in db [:playback :frame]))] (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 (rf/reg-event-fx
::overwrite-drawing ::overwrite-drawing
@ -229,24 +316,18 @@
(committed db sid result [::overwrite-drawing :grow-symbol])))) (committed db sid result [::overwrite-drawing :grow-symbol]))))
(rf/reg-event-db (rf/reg-event-db
::trim-cel ::trim
(fn [db [_ edge]] (fn [db [_ edge]]
(let [{:keys [clip sid id at]} (at-playhead db)] (let [{:keys [clip sid id at]} (at-playhead db)]
(apply-lane-command (apply-lane-command
db sid (if at db sid (if at (span/trim clip sid id edge at) no-frame) nil))))
(lane/trim clip sid id edge at)
{:refused "this lane's frames are not the open symbol's"})
nil))))
(rf/reg-event-db (rf/reg-event-db
::move-cel ::move
(fn [db _] (fn [db _]
(let [{:keys [clip sid id at]} (at-playhead db)] (let [{:keys [clip sid id at]} (at-playhead db)]
(apply-lane-command (apply-lane-command
db sid (if at db sid (if at (span/move clip sid id at) no-frame) nil))))
(lane/move clip sid id at)
{:refused "this lane's frames are not the open symbol's"})
nil))))
(rf/reg-event-db (rf/reg-event-db
::blank-cel ::blank-cel
@ -361,21 +442,22 @@
(update-in db [:ui :smart] #(let [on? (boolean on)] (update-in db [:ui :smart] #(let [on? (boolean on)]
((if on? conj disj) (set %) face))))) ((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: "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 INSIDE the aimed instance, or BESIDE an aimed node of any other kind, or at
of the open symbol when nothing is selected. the top of the open symbol when nothing is aimed.
A selection from a timeline row carries that row's path, because one symbol READ OFF THE TARGET, NEVER THE SELECTION. The two were one thing, and the
placed twice is two rows and only the path says which was clicked. One made on result was that clicking a shape on the stage to look at it re-aimed the next
the stage does not, and names a node directly in the open symbol." 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] [clip db]
(let [[kind sid id path] (get-in db [:ui :selection]) (let [{:keys [sid id path]} (get-in db [:ui :target])]
path (when (= :node kind) (or path [id]))]
(cond (cond
(nil? path) [] (empty? path) []
(= :instance (get-in clip [:symbols sid :nodes id :kind])) path (= :instance (get-in clip [:symbols sid :nodes id :kind])) path
:else (pop path)))) :else (vec (butlast path)))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; drawing a polygon ;; drawing a polygon
@ -386,11 +468,6 @@
;; reload is worth more than the handful of dispatches it costs. Clicks are rare; ;; reload is worth more than the handful of dispatches it costs. Clicks are rare;
;; this is not the drag path. ;; 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 (rf/reg-event-db
::cancel-polygon ::cancel-polygon
(fn [db _] (update db :ui merge {:tool nil :draft []}))) (fn [db _] (update db :ui merge {:tool nil :draft []})))
@ -402,22 +479,128 @@
(update-in db [:ui :draft] into [x y]) (update-in db [:ui :draft] into [x y])
db))) 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 ::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]) (let [draft (get-in db [:ui :draft])
open (get-in db [:ui :open]) open (get-in db [:ui :open])
{clip :clip st :store} (store/entry (:clip/current db)) {clip :clip st :store} (store/entry (:clip/current db))
down (where-new-goes clip db) landing (polygon-landing clip st db)
;; Drawn on the stage, stored where it goes: inside the selected source (:clip landing)
;; instance, re-expressed in that symbol's coordinates and frame so it down (:path landing)
;; lands exactly where it was drawn. {:keys [sid frame pts]}
{:keys [sid frame pts]} (nest/drawn-inside clip st open down (when-not (:refused landing)
(get-in db [:playback :frame]) draft)] (nest/drawn-inside source st open down (get-in db [:playback :frame]) draft))]
(cond (cond
(< (count draft) 6) {} (< (count draft) 6) db
(nil? sid) {:db (update db :project merge (:refused landing) (update db :project merge {:status (:refused landing)})
{:status "the selected instance is not on screen at this frame"})} (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 ;; `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 ;; 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 ;; out: a node's id is its identity in the saved document, so the pure
@ -425,11 +608,13 @@
;; log ever has to reproduce a document exactly, this becomes a cofx. ;; log ever has to reproduce a document exactly, this becomes a cofx.
:else :else
(let [id (keyword (str "paint-" (random-uuid)))] (let [id (keyword (str "paint-" (random-uuid)))]
{:db (-> db (-> db
(update :ui merge {:tool nil :draft [] (edit/transaction
:selection [:node sid id (conj down id)]}) (fn [_] (paint/new-shape source sid id frame pts (get-in db [:ui :tone]))))
(update-in [:ui :expanded] into (rest (reductions conj [] down)))) (update :ui merge {:tool nil :draft []
:dispatch [::paint/new-shape sid id frame pts (get-in db [:ui :tone])]}))))) :selection [:node sid id (conj down id)]})
(update-in [:ui :expanded] (fnil into #{})
(rest (reductions conj [] down)))))))))
(rf/reg-event-db (rf/reg-event-db
::set-knob ::set-knob
@ -441,22 +626,32 @@
(rf/reg-event-db (rf/reg-event-db
::new-symbol ::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)) (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 {host :sid frame :frame} (nest/inside clip st (get-in db [:ui :open]) down
(get-in db [:playback :frame])) (get-in db [:playback :frame]))
sid (clip/fresh-id clip) sid (clip/fresh-id clip)
uuid (random-uuid)] uuid (random-uuid)]
(if-not host (if-not host
(update db :project merge (update db :project merge
{:status "the selected instance is not on screen at this frame"}) {:status "what you are adding to is not on screen at this frame"})
(-> db (let [made [:node host uuid (conj down uuid)]]
(edit/edit #(clip/new-symbol % host sid frame uuid)) (-> db
(assoc-in [:ui :selection] [:node host uuid (conj down uuid)]) (edit/transaction #(clip/new-symbol % host sid frame uuid))
;; Open every row down to it, or the new row is inside a closed one ;; AIMED AT WHAT IT MADE. A symbol is made to put things in, so the
;; and the button looks like it did nothing. ;; next thing made goes in it; the outline says so before anybody
(update-in [:ui :expanded] into (rest (reductions conj [] down)))))))) ;; 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 ;; a drop in flight

30
frontend/src/arthur/subs/ui.cljs
View file

@ -12,6 +12,7 @@
[re-frame.core :as rf])) [re-frame.core :as rf]))
(rf/reg-sub ::selection (fn [db _] (get-in db [:ui :selection]))) (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 ::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 ::lane-retry (fn [db _] (get-in db [:ui :lane-retry])))
(rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone]))) (rf/reg-sub ::tone (fn [db _] (get-in db [:ui :tone])))
@ -53,6 +54,35 @@
(let [{clip :clip st :store} (store/entry clip-id)] (let [{clip :clip st :store} (store/entry clip-id)]
(nest/inside clip st open (or path [id]) f))))) (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 (rf/reg-sub
::selected-placement ::selected-placement
:<- [::selected-node] :<- [::selected-node]

35
frontend/src/arthur/ui/location.cljs
View file

@ -139,7 +139,13 @@
crumbs (trail clip open (if (and n (seq path)) path (when n [id]))) crumbs (trail clip open (if (and n (seq path)) path (when n [id])))
last-i (dec (count crumbs)) last-i (dec (count crumbs))
shared (shared-with clip n) 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 [:section.loc
[:nav.crumbs {:aria-label "editing location"} [:nav.crumbs {:aria-label "editing location"}
(doall (doall
@ -154,7 +160,9 @@
:title (if (zero? i) :title (if (zero? i)
"the open symbol — clear the selection" "the open symbol — clear the selection"
(str label " · " (if lane? "lane" (name crumb-kind)))) (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]]))] label]]))]
(when says (when says
[:span.loc-fact {:title "the frame this selection is showing, in its own time"} [: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 ;; explicit location." Both commands read the selection, and the trail to
;; the left of them is that selection written out. ;; the left of them is that selection written out.
[menu/view [menu/view
{:label "new" :title "add to the document, at the location named on the left" {:label "new" :title "add to the document"
:items [{:label "symbol" :items [{:label "inside"
:sub "empty, inside the selected instance or beside the selected node" :sub (if aimed
:on-click #(rf/dispatch [::ui/new-symbol])} (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" {: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])}]}]])) :on-click #(rf/dispatch [::ui/new-lane])}]}]]))

43
frontend/src/arthur/ui/stage.cljs
View file

@ -220,6 +220,45 @@
[:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3) [:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3)
" M " px " " (- py 3) " V " (+ py 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] (defn- overlay [w h]
(let [tool @(rf/subscribe [::sub/tool]) (let [tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft]) draft @(rf/subscribe [::sub/draft])
@ -280,6 +319,10 @@
(when (seq draft) (when (seq draft)
[:polyline {:points (points-text draft) :fill "none" [:polyline {:points (points-text draft) :fill "none"
:stroke "#d0ba86" :stroke-width 1}]) :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-not (or drawing? points?) [handles ctx])
(when (and id pts (not drawing?) (not (channel/nothing? pts))) (when (and id pts (not drawing?) (not (channel/nothing? pts)))
[:g [:g

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

@ -25,6 +25,7 @@
[arthur.domain.clip :as clip] [arthur.domain.clip :as clip]
[arthur.domain.nest :as nest] [arthur.domain.nest :as nest]
[arthur.domain.lane :as lane] [arthur.domain.lane :as lane]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol] [arthur.domain.symbol :as symbol]
[arthur.domain.trace :as trace] [arthur.domain.trace :as trace]
[arthur.events.playback :as pb] [arthur.events.playback :as pb]
@ -240,25 +241,34 @@
[_ sid id] selection [_ sid id] selection
open @(rf/subscribe [::render/open]) open @(rf/subscribe [::render/open])
st (:store (store/entry clip-id)) st (:store (store/entry clip-id))
sheet? (= :cel-sheet view)
n (get-in clip [:symbols sid :nodes id]) n (get-in clip [:symbols sid :nodes id])
lane (if (node/lane? n) n (get-in clip [:symbols sid :nodes (:parent n)])) lane (if (node/lane? n) n (get-in clip [:symbols sid :nodes (:parent n)]))
lane? (node/lane? lane) lane? (node/lane? lane)
cel? (and lane? (= :instance (:kind n)) (some? (node/source n))) cel? (and lane? (= :instance (:kind n)) (some? (node/source n)))
held? (and cel? (zero? (:speed (node/playback-of n)))) held? (and cel? (zero? (:speed (node/playback-of n))))
;; Shared use is shown rather than discovered: the row that decouples ;; A SPAN IS A SPAN WHEREVER IT SITS. What `span/split`, `trim` and
;; a cel is only offered where there is something to decouple from. ;; `move` need is one node with a place in time, which a symbol dropped
shared? (and cel? (< 1 (count (for [[_ sym] (:symbols clip) ;; straight into a shot has as surely as a cel does — so these are
[_ other] (:nodes sym) ;; offered on both, and a GROUP is the exception rather than a lane
:when (= (node/source n) (node/source other))] ;; being the rule: dividing one means deciding what becomes of its
other)))) ;; children, and nothing in a span says.
;; Both act at the playhead, so both are offered only where the playhead span? (and n (not= :group (:kind n)) (some? (node/placed-span n)))
;; is somewhere they mean something. ;; 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) 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)) at (when (and lane? (number? owner-frame))
(lane/lane-frame clip sid (:id lane) owner-frame)) (lane/lane-frame clip sid (:id lane) owner-frame))
insertable? (and lane? (integer? at)) 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))] act (fn [event] #(rf/dispatch event))]
[:div.pane-head [:div.pane-head
;; ----------------------------------------------------------------- time ;; ----------------------------------------------------------------- time
@ -313,67 +323,82 @@
label]))] label]))]
[:span.sep] [:span.sep]
;; ------------------------------------------------------------- commands ;; ------------------------------------------------------------- commands
;; Fourteen of these, and all but two mean nothing without a selected lane ;; GROUPED BY WHAT THEY NEED, not by which view they were built in.
;; 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, ;; `timing` is always here. Split, trim and move are one write to one
;; with the explanation on the row, they cost three slots and read as a ;; node's span or position, and that is a fact every placement has: a
;; vocabulary. There is also room here for the correction commands, which ;; symbol laid out in a shot is cut and trimmed exactly as a cel is, and
;; `docs/lane-handoff.md` says are next. ;; the lane gate they used to carry was a leftover from a lane being the
;; `new` is NOT here. Creating a symbol or a lane acts at the location the ;; only thing anybody had timed. Judging a cut against the other rows is
;; breadcrumb names, so it lives on the location bar beside it rather than ;; also the timeline's whole shape, so hiding them here would have cost
;; among the commands that act on a cel. `ui/location`. ;; 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 [menu/view
{:label "drawing" :title "what the lane exposes" {:label "timing" :title "where this sits and how long it lasts"
:note "select a lane, or a cel in one" :note "select a cel, or anything else placed in time"
:items [{:label "new drawing" :disabled? (not lane?) :items [{:label "split" :disabled? (not cuttable?)
:sub "append a new independent drawing to the selected lane" :sub "cut this in two at the playhead; the picture does not change"
:on-click (act [::ui/append-drawing])} :on-click (act [::ui/split])}
{:label "insert" :disabled? (not insertable?) {:label "trim in" :disabled? (not cuttable?)
:sub "a new drawing at the playhead; later drawings ripple later" :sub "start this at the playhead; nothing else moves"
:on-click (act [::ui/insert-drawing])} :on-click (act [::ui/trim :in])}
{:label "overwrite" :disabled? (not insertable?) {:label "trim out" :disabled? (not cuttable?)
:sub "replace the drawing at the playhead; later drawings stay put" :sub "end this at the playhead; nothing else moves"
:on-click (act [::ui/overwrite-drawing])} :on-click (act [::ui/trim :out])}
{:label "reuse" :disabled? (not cel?) {:label "move here" :disabled? (not movable?)
:sub "expose this same drawing again — one drawing, two cels" :sub "put this at the playhead; in a lane, refused if something is there"
:on-click (act [::ui/reuse-drawing])} :on-click (act [::ui/move])}]}]
{:label "duplicate" :disabled? (not cel?) (when sheet?
:sub "append a copy of this drawing, to draw the next one over it" [:<>
:on-click (act [::ui/duplicate-drawing])} [menu/view
{:label "make unique" :disabled? (not shared?) {:label "drawing" :title "what the aimed lane exposes"
:sub "give this cel its own copy; other cels keep sharing" :note "select a cel in the sheet"
:on-click (act [::ui/make-unique])}]}] :items [{:label "insert" :disabled? (not insertable?)
[menu/view :sub "a new drawing at the playhead; later drawings ripple later"
{:label "cel" :title "where this cel sits and how long it lasts" :on-click (act [::ui/insert-drawing])}
:note "select a cel in the timeline or the cel sheet" {:label "overwrite" :disabled? (not insertable?)
:items [{:label "split" :disabled? (not splittable?) :sub "replace the drawing at the playhead; later drawings stay put"
:sub "cut this cel in two at the playhead; the picture does not change" :on-click (act [::ui/overwrite-drawing])}
:on-click (act [::ui/split-cel])} {:label "reuse" :disabled? (not cel?)
{:label "trim in" :disabled? (not splittable?) :sub "expose this same drawing again — one drawing, two cels"
:sub "start this cel at the playhead; nothing else moves" :on-click (act [::ui/reuse-drawing])}
:on-click (act [::ui/trim-cel :in])} {:label "duplicate" :disabled? (not cel?)
{:label "trim out" :disabled? (not splittable?) :sub "append a copy of this drawing, to draw the next one over it"
:sub "end this cel at the playhead; nothing else moves" :on-click (act [::ui/duplicate-drawing])}
:on-click (act [::ui/trim-cel :out])} {:label "blank" :disabled? (not cel?)
{:label "move here" :disabled? (not (and cel? (integer? at))) :sub "clear this cel's frames, leaving a gap; later drawings stay put"
:sub "put this cel at the playhead; refused if something is there" :on-click (act [::ui/blank-cel])}]}]
:on-click (act [::ui/move-cel])} ;; THE ONE PAIR THAT STAYS A BUTTON. Deciding how many frames a drawing
{:label "blank" :disabled? (not cel?) ;; is held for is shooting on ones or twos — the most repeated edit in
:sub "clear this cel's frames, leaving a gap; later drawings stay put" ;; the list, done by eye, a frame at a time. Two clicks into a menu per
:on-click (act [::ui/blank-cel])}]}] ;; frame would be the one place this consolidation made the tool worse.
;; THE ONE PAIR THAT STAYS A BUTTON. Deciding how many frames a drawing is [:span.stepper
;; held for is shooting on ones or twos — the most repeated edit in the [:span.stepper-label "hold"]
;; list, done by eye, a frame at a time. Two clicks into a menu per frame [:span.group
;; would be the one place this consolidation made the tool worse. [:button {:disabled (not held?) :aria-label "hold −"
[:span.stepper :title "shorten this cel; ripple later drawings, keeping lane keys fixed"
[:span.stepper-label "hold"] :on-click (act [::ui/extend-hold -1])} "−"]
[:span.group [:button {:disabled (not held?) :aria-label "hold +"
[:button {:disabled (not held?) :aria-label "hold −" :title "extend this cel; ripple later drawings, keeping lane keys fixed"
:title "shorten this cel; ripple later drawings, keeping lane keys fixed" :on-click (act [::ui/extend-hold 1])} "+"]]]])
: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] [:span.spacer]
;; After the spacer, both of them: an offer that appears and a reading that ;; 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. ;; 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"})))))) (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]} (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) (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] [over-path where] @over]
[:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on") [:div (cond-> {:class (str "tl-label" (when (and select (= select selection)) " on")
(when aimed? " aimed")
(when (= :ghost kind) " ghost") (when (= :ghost kind) " ghost")
(when (= path over-path) (when (= path over-path)
(case where (case where
@ -432,7 +463,12 @@
:style {:padding-left (str (+ 4 (* 11 depth)) "px")} :style {:padding-left (str (+ 4 (* 11 depth)) "px")}
:title label :title label
:ref (when (and select (= select selection)) (reveal selection)) :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. ;; An instance's row opens the symbol it places, as a tab.
:on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))} :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 ;; 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)) frames (max 1 (or @(rf/subscribe [::render/frames]) 1))
frame @(rf/subscribe [::playback/frame]) frame @(rf/subscribe [::playback/frame])
selection @(rf/subscribe [::sub/selection]) selection @(rf/subscribe [::sub/selection])
target @(rf/subscribe [::sub/target])
expanded @(rf/subscribe [::sub/expanded]) expanded @(rf/subscribe [::sub/expanded])
drop @(rf/subscribe [::sub/drop]) drop @(rf/subscribe [::sub/drop])
solo (set @(rf/subscribe [::render/solo])) solo (set @(rf/subscribe [::render/solo]))
@ -626,7 +663,7 @@
(doall (for [row visible] (doall (for [row visible]
(with-meta (if (= :section (:kind row)) (with-meta (if (= :section (:kind row))
[:div.tl-label.tl-section (:label 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))})))] {:key (str (:path row))})))]
[:div.tl-tracks [:div.tl-tracks
{:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e))) {:on-drag-enter (fn [^js e] (when (drag/accepts?) (.preventDefault e)))
@ -708,7 +745,16 @@
frames (max 1 (or @(rf/subscribe [::render/frames]) 1)) frames (max 1 (or @(rf/subscribe [::render/frames]) 1))
frame @(rf/subscribe [::playback/frame]) frame @(rf/subscribe [::playback/frame])
selection @(rf/subscribe [::sub/selection]) selection @(rf/subscribe [::sub/selection])
target @(rf/subscribe [::sub/target])
columns (cel-sheet clip sid frames) 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)) active (when (and (= sid (:sid @range-state))
(= clip-id (:clip-id @range-state))) @range-state) (= clip-id (:clip-id @range-state))) @range-state)
[ac af] (:anchor active) [ac af] (:anchor active)
@ -719,11 +765,16 @@
bottom (when active (max af bf)) bottom (when active (max af bf))
lanes (when (and active (< right (count columns))) lanes (when (and active (< right (count columns)))
(mapv :id (subvec columns left (inc right)))) (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?] choose! (fn [c f extend?]
(reset! range-state {:sid sid :clip-id clip-id (reset! range-state {:sid sid :clip-id clip-id
:anchor (if (and extend? active) (:anchor active) [c f]) :anchor (if (and extend? active) (:anchor active) [c f])
:focus [c f]}) :focus [c f]})
(rf/dispatch [::pb/seek 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]) (rf/dispatch [::ui/select (or (get-in columns [c :cells f :cel :select])
(:select (nth columns c)))])) (:select (nth columns c)))]))
clear! #(when lanes clear! #(when lanes
@ -758,6 +809,16 @@
cmd? (or (.-metaKey e) (.-ctrlKey e)) cmd? (or (.-metaKey e) (.-ctrlKey e))
arrow (get {"arrowup" [0 -1] "arrowdown" [0 1] arrow (get {"arrowup" [0 -1] "arrowdown" [0 1]
"arrowleft" [-1 0] "arrowright" [1 0]} k)] "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) (when (and lanes (or arrow (#{"delete" "backspace" "escape"} k)
(and cmd? (#{"c" "x" "v"} k)))) (and cmd? (#{"c" "x" "v"} k))))
(.preventDefault e) (.preventDefault e)
@ -783,10 +844,19 @@
(str "Extend hold to frame " (dec (:end @gesture)) " · later cels move with it") (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")] "Drag to select · Shift extends · ⌘/Ctrl C/X/V · Delete clears · drag a hold’s corner to resize")]
[:div.cs-head.cs-frame "frame"] [: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)} ^{:key (str "head-" path)}
[:button.cs-head {:class (when (= select selection) "selected") ;; A HEAD AIMS AND DOES NOT SELECT. Clicking a column's name says
:on-click #(rf/dispatch [::ui/select select])} ;; "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])) label]))
(doall (doall
(for [f (range frames) (for [f (range frames)
@ -831,7 +901,26 @@
(reset! gesture {:kind :hold :id id :column c (reset! gesture {:kind :hold :id id :column c
:start (first span) :end (second span)})))}])]))))]))) :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 [] (defn view []
(if (= :cel-sheet @(rf/subscribe [::sub/time-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])) [timeline-view]))

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

@ -10,6 +10,7 @@
[arthur.domain.palette :as pal] [arthur.domain.palette :as pal]
[arthur.domain.pick :as pick] [arthur.domain.pick :as pick]
[arthur.domain.lane :as lane] [arthur.domain.lane :as lane]
[arthur.domain.span :as span]
[arthur.domain.symbol :as symbol])) [arthur.domain.symbol :as symbol]))
(defn drawing [id x frames] (defn drawing [id x frames]
@ -410,44 +411,10 @@
{:at 4 :extent :grow-symbol}) {:at 4 :extent :grow-symbol})
[:clip :symbols :main :nodes :n])))))) [: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 (deftest split-then-place-puts-a-drawing-inside-a-hold
;; The two commands the doc asks for, composed: neither one guesses. ;; The two commands the doc asks for, composed: neither one guesses.
(let [doc (document) (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 r (lane/append-drawing cut :main :girl :n :drawing-n
{:at 2 :extent :grow-symbol}) {:at 2 :extent :grow-symbol})
after (:clip r)] after (:clip r)]
@ -519,65 +486,6 @@
(defn- spans [clip ids] (defn- spans [clip ids]
(mapv #(node/placed-span (get-in clip [:symbols :main :nodes %])) 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 (deftest blanking-leaves-a-gap-and-does-not-close-it
(let [doc (document) (let [doc (document)
r (lane/blank doc :main :girl [5 7] {:id :rest}) 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 (is (= 21 (get-in (lane/append-drawing empty-lane :main :girl :n :drawing-n
{:at 20 :extent :grow-symbol}) {:at 20 :extent :grow-symbol})
[:clip :symbols :main :frames]))) [: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])) [:symbols :main :frames]))
"and trimming the last cel leaves the window where it was"))) "and trimming the last cel leaves the window where it was")))

223
frontend/test/arthur/domain/span_test.cljs Normal file
View file

@ -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")))

91
frontend/test/arthur/events/lane_test.cljs
View file

@ -1,11 +1,13 @@
(ns arthur.events.lane-test (ns arthur.events.lane-test
(:require [cljs.test :refer [deftest is]] (:require [cljs.test :refer [deftest is]]
[arthur.domain.lane-test :as fixture] [arthur.domain.lane-test :as fixture]
[arthur.domain.clip :as clip]
[arthur.domain.correction :as correction] [arthur.domain.correction :as correction]
[arthur.domain.lane :as lane] [arthur.domain.lane :as lane]
[arthur.events.ui :as ui] [arthur.events.ui :as ui]
[arthur.domain.history :as history] [arthur.domain.history :as history]
[arthur.domain.leaf :as leaf] [arthur.domain.leaf :as leaf]
[arthur.domain.symbol :as symbol]
[arthur.footage.store :as store] [arthur.footage.store :as store]
[arthur.ui.timeline :as timeline])) [arthur.ui.timeline :as timeline]))
@ -47,6 +49,95 @@
(is (= 12 (ui/selection-frame doc nil :main (is (= 12 (ui/selection-frame doc nil :main
[:node :main :a [:a]] 12))))) [: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 (deftest sequence-commands-use-isolated-history-transactions
(let [doc (fixture/document) (let [doc (fixture/document)
id (store/install! {:clip doc :store {}} "sequence-test") id (store/install! {:clip doc :store {}} "sequence-test")

49
static/arthur/app.css
View file

@ -40,6 +40,22 @@
--sel: #2f6fc0; --sel: #2f6fc0;
--sel-bg: #cfe0f5; --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;
/* A keyframe is a dot and a dot is ink. Flash draws them black and so does /* 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. */ this; the frames a node exists over are a pale tint behind them. */
--key: #1f1f1f; --key: #1f1f1f;
@ -1161,6 +1177,26 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.cs-cell:hover { background: var(--sel-bg); } .cs-cell:hover { background: var(--sel-bg); }
.cs-cell.selected { background: var(--sel-bg); color: var(--sel); font-weight: 600; } .cs-cell.selected { background: var(--sel-bg); color: var(--sel); font-weight: 600; }
.cs-head.selected { background: var(--sel-bg); color: var(--sel); } .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; } .cel-sheet { user-select: none; touch-action: none; }
.cs-cell { position: relative; } .cs-cell { position: relative; }
.cs-cell:focus-visible { outline: 2px solid var(--sel); outline-offset: -2px; } .cs-cell:focus-visible { outline: 2px solid var(--sel); outline-offset: -2px; }
@ -1254,4 +1290,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 .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 .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; } .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; } .paint-overlay:focus { outline: none; }