Select, move, turn and scale on the stage, at any depth

A click selects the thing in the open symbol, a double-click goes one
level in, ⌘-click goes to the shape itself and Esc comes back out —
Figma's rule — and a click inside the selection keeps it, so a shape
several symbols down can be dragged. The selection is the one a
timeline row makes, so the inspector shows it and its row opens and
scrolls into view.

A drag writes what the inspector writes: a key on the node's own frame
where the channel has keys, its one value where it has none. It is
previewed like a bar being slid and let go as one edit, so one undo
step. Measured transforms refuse. A shape's points are edited by
double-clicking it, and new shapes turn about their middle.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-30 02:12:31 -04:00
parent 2a0426707a
commit 550cfe91e5
12 changed files with 584 additions and 23 deletions

View file

@ -0,0 +1,79 @@
(ns arthur.domain.gesture
"Moving, turning and scaling a node by hand on the stage, as channel values.
A drag says where the pointer went in stage pixels; this says what that makes
the node's `[:xform :pos]`, `[:xform :rot]` or `[:xform :scale]`, given its
`nest/placement`. Whatever is above the node — instances, parents, a `:pinv` —
is in the placement's matrices, so a shape five symbols down moves under the
pointer like one on top.
THE KEYING RULE IS `node/set-channel`, the inspector's: a channel with keys
gets one on the node's own frame, and one without has its one value changed.
After Effects' stopwatch — there is no mode to be in, and nothing snaps back
on the next frame as an unkeyed change does in Blender."
(:require [arthur.domain.channel :as ch]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]))
(defn values
"Node `n`'s transform on its own frame `f`, as vectors."
[n f]
(let [at #(ch/value-at (get (node/channels n) [:xform %]) f)
xy #(let [v (at %)] [(ch/component v 0) (ch/component v 1)])]
{:pos (xy :pos) :rot (at :rot) :scale (xy :scale) :anchor (xy :anchor)}))
(defn refusal
"Why node `n`'s transform cannot be set by hand, or nil when it can. A
measured transform is regenerated from the footage, and writing a value over
it would throw the measurement away."
[n]
(cond
(seq (:anchors n)) "its motion is measured — place the instance it is in"
(some #(let [c (get-in n [:channels [:xform %]])] (or (:dense c) (:generated c)))
[:pos :rot :scale])
"its transform is measured — place the instance it is in"))
(defn- through [m [x y]]
(let [out (js/Float64Array. 2)]
(node/apply-pt! out 0 m x y)
[(aget out 0) (aget out 1)]))
(defn move
"The node's position with its pivot carried from stage point `p0` to `p1`."
[{:keys [parent]} {:keys [pos]} p0 p1]
(when-let [inv (nest/invert parent)]
{[:xform :pos] (mapv + pos (mapv - (through inv p1) (through inv p0)))}))
(defn angle
"The angle of stage point `p` about the node's pivot, in the space its
rotation is in."
[{:keys [parent]} {:keys [pos anchor]} p]
(when-let [inv (nest/invert parent)]
(let [[x y] (mapv - (through inv p) (mapv + pos anchor))]
(js/Math.atan2 y x))))
(defn turn
"The node's rotation, turned by `da` radians."
[{:keys [rot]} da]
{[:xform :rot] (+ rot da)})
(defn scale
"The node's scale with the point under stage `p0` taken to `p1`, about its
pivot, along its own axes — or by the same factor on both when `uniform?`."
[{:keys [world]} {:keys [anchor] s :scale} p0 p1 uniform?]
(when-let [inv (nest/invert world)]
(let [a (mapv - (through inv p0) anchor)
b (mapv - (through inv p1) anchor)
k (fn [a b] (if (< (js/Math.abs a) 1e-6) 1 (/ b a)))
r (if uniform?
(let [aa (reduce + (map * a a))]
(if (< aa 1e-9) 1 (/ (reduce + (map * a b)) aa)))
nil)]
{[:xform :scale] (if r (mapv #(* r %) s) (mapv * s (map k a b)))})))
(defn apply-values
"Clip with channel values `vs`, `{path value}`, written into node `id` of
symbol `sid` on the node's own frame `f`, by the keying rule above."
[clip sid id f vs]
(update-in clip [:symbols sid :nodes id]
#(reduce-kv (fn [n path v] (node/set-channel n path f v)) % vs)))

View file

@ -82,6 +82,28 @@
{:sid sid :frame f :matrix (node/mat) :time {:at 0 :rate 1}}
path))
(defn placement
"Where the node at row path `path` is, from symbol `sid` showing frame `f`, as
a transform would change it: `{:sid :id :frame :parent :world}` — the symbol it
lives in, its own frame, the matrix from the space its `[:xform :pos]` is in to
`sid`'s, and the one from its own coordinates. Nil when it is not on screen.
`:parent` is everything above the node's own transform, `world = parent ·
local`: its symbol's way to the stage, its parents there, and its `:pinv`."
[clip store sid path f]
(when-let [{:keys [sid frame matrix]} (inside clip store sid (pop path) f)]
(let [id (peek path)
n (get-in clip [:symbols sid :nodes id])
r (when n (resolved clip store sid frame id))
w (when r (symbol/world-of r id))]
(when w
{:sid sid :id id
:frame (js/Math.floor (symbol/frame-of r id))
:parent (reduce #(node/mul! (node/mat) %1 %2) matrix
(keep identity [(some->> (:parent n) (symbol/world-of r))
(node/pinv n)]))
:world (node/mul! (node/mat) matrix w)}))))
(defn drawn-inside
"Flat points drawn on symbol `sid`'s stage at frame `f`, re-expressed inside the
symbol `path` leads to, so a shape added there lands exactly where it was drawn.

View file

@ -26,7 +26,12 @@
:kind :poly :paint? true :parent nil :z z
:span [frame end]
:channels {geometry (channel/keyed {frame points})
[:style :color] (channel/framed color)}})
[:style :color] (channel/framed color)
;; Turned and scaled about its middle, as a placed
;; symbol is: set once here and never followed.
[:xform :anchor]
(channel/framed (mapv (fn [vs] (/ (+ (apply min vs) (apply max vs)) 2))
[(take-nth 2 points) (take-nth 2 (rest points))]))}})
clip)))
(defn add-key [clip sid id frame]

View file

@ -0,0 +1,109 @@
(ns arthur.domain.pick
"What is under the pointer on the stage, and which row a click on it selects.
THE OPS ALREADY SAY. The stage draws a flat list of ops, and each op's `:node`
is the row path of what drew it — the instances down to it and its own id — so
hit-testing is a walk of the list, topmost first, and needs nothing resolved.
WHICH LEVEL a click selects is Figma's and Illustrator's rule, and Flash's
without its edit mode: a click selects the thing in the open symbol, a
double-click goes one level into what is selected, ⌘-click goes straight to the
shape itself. A click inside what is selected keeps it, so a deep selection can
be dragged; one elsewhere selects at the same depth, beside it."
(:require [arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.node :as node]
[arthur.domain.palette :as pal]))
(def ^:private slop
"Stage pixels a click may miss by. The shapes here are a few pixels across."
2)
(defn- path-of [op]
(let [n (:node op)] (if (vector? n) n [n])))
(defn- near-segment? [x y ax ay bx by]
(let [dx (- bx ax) dy (- by ay)
l2 (+ (* dx dx) (* dy dy))
t (if (zero? l2) 0 (-> (/ (+ (* (- x ax) dx) (* (- y ay) dy)) l2) (max 0) (min 1)))
ex (- x (+ ax (* t dx)))
ey (- y (+ ay (* t dy)))]
(<= (+ (* ex ex) (* ey ey)) (* slop slop))))
(defn- on-poly? [^js pts n x y]
(let [px #(aget pts (* 2 (mod % n)))
py #(aget pts (inc (* 2 (mod % n))))]
(or (odd? (count (filter (fn [i]
(let [ay (py i) by (py (inc i))]
(and (not= (> ay y) (> by y))
(< x (+ (px i) (/ (* (- y ay) (- (px (inc i)) (px i)))
(- by ay)))))))
(range n))))
(some #(near-segment? x y (px %) (py %) (px (inc %)) (py (inc %))) (range n)))))
(defn- on? [{:keys [kind pts n cx cy r size]} x y]
(case kind
:poly (on-poly? pts n x y)
:disc (<= (js/Math.hypot (- x cx) (- y cy)) (+ r slop))
:rect (let [h (+ slop (/ size 2))]
(and (<= (js/Math.abs (- x cx)) h) (<= (js/Math.abs (- y cy)) h)))
false))
(defn hit
"The row path of the topmost op in `ops`, in draw order, at stage point `[x y]`,
or nil."
[ops [x y]]
(some #(when (on? % x y) (path-of %)) (rseq (vec ops))))
(defn- prefix? [a b]
(and (<= (count a) (count b)) (= a (subvec b 0 (count a)))))
(defn choose
"The row path a click on `hit` selects, with `selected` the one selected now."
[selected hit deep?]
(cond
(nil? hit) nil
deep? hit
(and selected (prefix? selected hit)) selected
(and selected (prefix? (pop selected) hit)) (subvec hit 0 (count selected))
:else [(first hit)]))
(defn deeper
"One level into `selected` towards `hit`, for a double-click."
[selected hit]
(if (and selected hit (prefix? selected hit) (< (count selected) (count hit)))
(subvec hit 0 (inc (count selected)))
selected))
(defn local-bounds
"`[x0 y0 x1 y1]` around what node `n` draws on its own frame `f`, in its own
coordinates, or nil when it draws nothing there. Inside an instance is its
symbol, resolved at that frame."
[document store n f]
(let [grow (fn [[x0 y0 x1 y1 :as b] x y]
(if b [(min x0 x) (min y0 y) (max x1 x) (max y1 y)] [x y x y]))
at #(ch/value-at (get (node/channels n) %) f store)]
(case (:kind n)
:instance
(let [sid (:of n)
frames (clip/frames document sid)
f (if (get-in n [:time :loop?]) (mod f frames) f)]
(when (< -1 f frames)
(reduce (fn [b {:keys [kind pts n cx cy r size]}]
(case kind
:poly (reduce #(grow %1 (aget pts (* 2 %2)) (aget pts (inc (* 2 %2))))
b (range n))
:disc (-> b (grow (- cx r) (- cy r)) (grow (+ cx r) (+ cy r)))
:rect (let [h (/ size 2)]
(-> b (grow (- cx h) (- cy h)) (grow (+ cx h) (+ cy h))))
b))
nil
((clip/resolver document store pal/index-of sid) f))))
:poly (let [pts (at [:geom :pts])]
(when-not (ch/nothing? pts)
(reduce (fn [b i] (grow b (ch/component pts (* 2 i)) (ch/component pts (inc (* 2 i)))))
nil (range (quot (if (vector? pts) (count pts) (.-length pts)) 2)))))
:disc (let [r (at [:geom :radius])] (when-not (ch/nothing? r) [(- r) (- r) r r]))
:rect (let [s (at [:geom :size])]
(when-not (ch/nothing? s) (let [h (/ s 2)] [(- h) (- h) h h])))
nil)))

View file

@ -6,6 +6,7 @@
there should not be one: an editor's own state is the cheapest thing in the
app to change and the most expensive to have two copies of."
(:require [arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.events.edit :as edit]
[arthur.events.paint :as paint]
@ -14,7 +15,15 @@
(rf/reg-event-db
::select
(fn [db [_ selection]] (assoc-in db [:ui :selection] selection)))
;; The rows above a selection are opened, so one made deep on the stage is
;; seen in the timeline.
(fn [db [_ selection]]
(let [[kind _ _ path] selection]
(cond-> (-> db
(assoc-in [:ui :selection] selection)
(update :ui dissoc :points))
(and (= :node kind) path)
(update-in [:ui :expanded] (fnil into #{}) (rest (reductions conj [] (pop path))))))))
(rf/reg-event-db
::set-tone
@ -207,6 +216,32 @@
(:refused r) (refused db (:refused r))
:else (edit/edit db (constantly (:clip r)))))))
(rf/reg-event-db
::points
;; Editing the selected shape's points rather than transforming it — a
;; double-click on the shape, as Figma's, which is one level further in. Any
;; new selection leaves it.
(fn [db [_ on?]]
(if on? (assoc-in db [:ui :points] true) (update db :ui dissoc :points))))
(rf/reg-event-db
::refuse
(fn [db [_ why]] (refused db why)))
(rf/reg-event-db
::gesture
;; A transform in the middle of a drag on the stage, `{:sid :id :frame
;; :values}`, drawn by `::render/clip` as `::sliding` is; nil when abandoned.
(fn [db [_ g]]
(if g (assoc-in db [:ui :gesture] g) (update db :ui dissoc :gesture))))
(rf/reg-event-db
::transform
;; The drag let go: one edit, so one undo step and one write to collaborators.
(fn [db [_ {:keys [sid id frame values]}]]
(cond-> (update db :ui dissoc :gesture)
(seq values) (edit/edit #(gesture/apply-values % sid id frame values)))))
(rf/reg-event-db
::delete-selected
(fn [db _]

View file

@ -8,6 +8,7 @@
recomputation here and a frame costs a lookup and a blit — and, crucially, the
playhead is not an input, so moving it cannot invalidate this."
(:require [arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.domain.palette :as pal]
[arthur.footage.store :as footage]
@ -19,6 +20,7 @@
(rf/reg-sub ::open (fn [db _] (get-in db [:ui :open])))
(rf/reg-sub ::sliding (fn [db _] (get-in db [:ui :sliding])))
(rf/reg-sub ::gesture (fn [db _] (get-in db [:ui :gesture])))
(rf/reg-sub ::solo (fn [db _] (get-in db [:ui :solo (get-in db [:ui :open])])))
(rf/reg-sub
@ -26,14 +28,17 @@
:<- [::clip-id]
:<- [::paint-revision]
:<- [::sliding]
:<- [::gesture]
:<- [::open]
(fn [[id _ sliding open] _]
(fn [[id _ sliding gesture open] _]
;; With a timeline bar being slid, the document as it will be when the drag
;; lets go, so the stage and the rows follow the pointer. Nothing is written
;; until then: one drag is one undo step and one write to collaborators.
(let [c (:clip (footage/entry id))]
(or (when-let [{:keys [path df]} sliding]
(:clip (nest/slide c open path df)))
(when-let [{:keys [sid id frame values]} gesture]
(when c (gesture/apply-values c sid id frame values)))
c))))
(rf/reg-sub

View file

@ -5,6 +5,7 @@
Cheap by construction, like `subs/playback`: each reads a path and returns a
value, so clicking a swatch notifies the swatches and nothing else."
(:require [arthur.domain.nest :as nest]
[arthur.domain.pick :as pick]
[arthur.footage.store :as store]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
@ -19,6 +20,7 @@
(rf/reg-sub ::tabs (fn [db _] (get-in db [:ui :tabs])))
(rf/reg-sub ::expanded (fn [db _] (get-in db [:ui :expanded])))
(rf/reg-sub ::knobs (fn [db _] (get-in db [:ui :knobs])))
(rf/reg-sub ::points (fn [db _] (get-in db [:ui :points])))
(rf/reg-sub
::selected-node
@ -49,6 +51,23 @@
(let [{clip :clip st :store} (store/entry clip-id)]
(nest/inside clip st open (or path [id]) f)))))
(rf/reg-sub
::selected-placement
:<- [::selected-node]
:<- [::selection]
:<- [::render/clip]
:<- [::render/clip-id]
:<- [::render/open]
:<- [::playback/frame]
(fn [[[_ id n] [_ _ _ path] clip clip-id open f] _]
;; `nest/placement` of the selected node, and `:bounds` around what it draws
;; in its own coordinates, for the stage's handles. From the clip as it is
;; mid-drag, so the handles go with what they move.
(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/local-bounds clip st n (:frame pl))))))))
(rf/reg-sub
::project-footage
:<- [::render/clip-id]

View file

@ -19,6 +19,7 @@
times a second at a 30fps clip on a 60Hz display, not sixty — and it carries
no global interceptors."
(:require [arthur.clock :as clock]
[arthur.domain.pick :as pick]
[arthur.domain.raster :as raster]
[arthur.events.playback :as pb]
[arthur.subs.playback :as sub]
@ -129,6 +130,14 @@
raster
(:raster (swap! state assoc :raster (raster/make w h))))))
(defn at
"The topmost row path drawn at stage point `point` on the frame last painted,
or nil. Read off the ops the canvas was drawn from, so a click picks exactly
what is seen: their point buffers stay good until the next paint, and a
pointer event is handled between two."
[point]
(pick/hit (:ops @state) point))
(defn paint!
"Resolve `f` and put it on the canvas. `ops` are consumed here and only here —
the resolver reuses its point buffers between frames, so they have to be
@ -145,9 +154,11 @@
;; independent of the footage, so the size the frame is rasterised at comes
;; out of the document like everything else.
(let [ras (raster-for width height)]
(let [ops (resolver f)]
(swap! state assoc :ops ops)
(-> ras
(raster/clear! (get palette :bg 0))
(raster/draw-ops! (resolver f)))
(raster/draw-ops! ops)))
(js/performance.mark "arthur/blit:start")
(canvas/blit! canvas ras ramp))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")

View file

@ -10,11 +10,14 @@
THE CANVAS IS THE RASTER'S OWN SIZE, scaled by CSS. See `ui/canvas` for why
that is load-bearing rather than convenient."
(:require [arthur.domain.channel :as channel]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.pick :as pick]
[arthur.events.paint :as paint-events]
[arthur.events.ui :as ui]
[arthur.footage.store :as store]
[arthur.subs.playback :as playback]
[arthur.subs.render :as render]
[arthur.subs.ui :as sub]
@ -101,32 +104,164 @@
[:path {:d (str "M " (- cx 5) " " cy " H " (+ cx 5)
" M " cx " " (- cy 5) " V " (+ cy 5))}]]))))
(defn- xy
"Where a pointer event is, in stage pixels, unrounded and unclamped: a drag
holding the pointer may leave the stage and still be moving something."
[^js svg event w h]
(let [box (.getBoundingClientRect svg)]
[(/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
(/ (* (- (.-clientY event) (.-top box)) h) (.-height box))]))
;; The move, turn or scale being dragged, as `dragging` is for a vertex: the
;; placement and transform it started from, and where. What it makes of the
;; pointer goes out as `::ui/gesture`, and on the way up as one `::ui/transform`.
(defonce ^:private gesture (atom nil))
(defn- select!
"Select the node at row path `path` of the open symbol — the selection a
timeline row makes, so the row, the inspector and the stage all show it — or
nothing."
[{:keys [document st open f]} path]
(rf/dispatch [::ui/select (when-let [{:keys [sid id]} (when (seq path)
(nest/placement document st open path f))]
[:node sid id path])]))
(defn- begin!
"Start dragging `kind` of the node at `path` from stage point `p`."
[{:keys [document st open f]} kind path p]
(when-let [{:keys [sid id frame] :as pl} (nest/placement document st open path f)]
(let [n (get-in document [:symbols sid :nodes id])
v0 (gesture/values n frame)]
(reset! gesture {:kind kind :pl pl :v0 v0 :p0 p :n n
:a (gesture/angle pl v0 p) :turned 0}))))
(defn- drag! [p ^js event]
(let [{:keys [kind pl v0 p0 n a turned values]} @gesture
shift? (.-shiftKey event)
moved? (or values (< 1 (js/Math.hypot (- (first p) (first p0)) (- (second p) (second p0)))))]
(when moved?
(if-let [why (gesture/refusal n)]
(do (reset! gesture nil) (rf/dispatch [::ui/refuse why]))
(let [vs (case kind
:move (gesture/move pl v0 p0 p)
:scale (gesture/scale pl v0 p0 p shift?)
:turn (let [b (gesture/angle pl v0 p)
d (- b a)
t (+ turned (- d (* 2 js/Math.PI (js/Math.round (/ d (* 2 js/Math.PI))))))
q (/ js/Math.PI 12)]
(swap! gesture assoc :a b :turned t)
;; ⇧ turns in 15° steps, as everywhere.
(gesture/turn v0 (if shift?
(- (* q (js/Math.round (/ (+ (:rot v0) t) q))) (:rot v0))
t))))]
(when vs
(swap! gesture assoc :values vs)
(rf/dispatch [::ui/gesture (assoc (select-keys pl [:sid :id :frame]) :values vs)])))))))
(defn- let-go! [commit?]
(when-let [{:keys [pl values]} @gesture]
(reset! gesture nil)
(when values
(rf/dispatch (if commit?
[::ui/transform (assoc (select-keys pl [:sid :id :frame]) :values values)]
[::ui/gesture nil])))))
(defn- handles
"The selected node's box, drawn through its own transform so it turns with
it: a square on each corner to scale by, a knob above to turn by, and a cross
on the pivot. Dragging inside it moves it — that is the stage's own
pointerdown, which keeps a selection it lands inside."
[ctx]
(let [{:keys [world bounds node frame]} @(rf/subscribe [::sub/selected-placement])
[_ _ _ path] @(rf/subscribe [::sub/selection])
[ax ay] (when world (:anchor (gesture/values node frame)))
[px py] (when world (through world [ax ay]))
grab (fn [kind]
(fn [^js event]
(.stopPropagation event)
(.preventDefault event)
(let [svg (.-ownerSVGElement (.-currentTarget event))]
(.setPointerCapture svg (.-pointerId event))
(begin! ctx kind path (xy svg event (:w ctx) (:h ctx))))))]
(when world
[:g.handles
(when-let [[x0 y0 x1 y1] bounds]
(let [corners (partition 2 (through world [x0 y0 x1 y0 x1 y1 x0 y1]))
[cx cy tx ty] (through world [(/ (+ x0 x1) 2) (/ (+ y0 y1) 2) (/ (+ x0 x1) 2) y0])
len (max 1e-6 (js/Math.hypot (- tx cx) (- ty cy)))
[kx ky] [(+ tx (* 8 (/ (- tx cx) len))) (+ ty (* 8 (/ (- ty cy) len)))]]
[:<>
[:polygon.box {:points (points-text (flatten corners))}]
[:line.knob-arm {:x1 tx :y1 ty :x2 kx :y2 ky}]
[:circle.knob {:cx kx :cy ky :r 2.2 :on-pointer-down (grab :turn)}]
(doall
(for [[i [x y]] (map-indexed vector corners)]
^{:key i}
[:rect.corner {:x (- x 1.8) :y (- y 1.8) :width 3.6 :height 3.6
:on-pointer-down (grab :scale)}]))]))
[:path.pivot {:d (str "M " (- px 3) " " py " H " (+ px 3)
" M " px " " (- py 3) " V " (+ py 3))}]])))
(defn- overlay [w h]
(let [tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft])
drawing? (= :polygon tool)
[sid id geom active editable? frame matrix] (editing)
[_ _ _ selected] @(rf/subscribe [::sub/selection])
clip-id @(rf/subscribe [::render/clip-id])
ctx {:document (:clip (store/entry clip-id)) :st (:store (store/entry clip-id))
:open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::playback/frame])
:w w :h h}
points? @(rf/subscribe [::sub/points])
[sid id geom active editable? frame matrix] (when points? (editing))
pts (when geom (through matrix (channel/value-at geom frame)))]
[:svg {:class (str "paint-overlay" (when drawing? " drawing"))
:width (* zoom w) :height (* zoom h)
:view-box (str "0 0 " w " " h)
:on-pointer-down (fn [event]
(when drawing?
:tab-index -1
:on-pointer-down (fn [^js event]
(if drawing?
(let [[x y] (stage-point event w h)]
(rf/dispatch [::ui/add-draft-point x y]))))
(rf/dispatch [::ui/add-draft-point x y]))
(let [svg (.-currentTarget event)
p (xy svg event w h)
path (pick/choose selected (player/at p)
(or (.-metaKey event) (.-ctrlKey event)))]
(.focus svg)
(when (not= path selected) (select! ctx path))
(when path
(.setPointerCapture svg (.-pointerId event))
(begin! ctx :move path p)))))
:on-double-click (fn [^js event]
(when-not drawing?
(let [p (xy (.-currentTarget event) event w h)
hit (player/at p)
path (pick/deeper selected hit)]
(cond
(not= path selected) (select! ctx path)
(= hit selected) (rf/dispatch [::ui/points true])))))
:on-key-down (fn [^js event]
;; Out a level, as Figma's Esc: the instance that
;; holds what is selected, then nothing.
(when (and (= "Escape" (.-key event)) selected (not drawing?))
(if points?
(rf/dispatch [::ui/points false])
(select! ctx (pop selected)))))
:on-pointer-move (fn [event]
;; Back through the inverse of what the handle was
;; drawn through, into the shape's own coordinates.
(when-let [[sid node key-frame vertex inv] @dragging]
(if-let [[sid node key-frame vertex inv] @dragging]
(rf/dispatch [::paint-events/set-vertex
sid node key-frame vertex
(through inv (stage-point event w h))])))
:on-pointer-up (fn [_] (reset! dragging nil))
:on-pointer-cancel (fn [_] (reset! dragging nil))}
(through inv (stage-point event w h))])
(when @gesture
(drag! (xy (.-currentTarget event) event w h) event))))
:on-pointer-up (fn [_] (reset! dragging nil) (let-go! true))
:on-pointer-cancel (fn [_] (reset! dragging nil) (let-go! false))}
[ghost]
(when (seq draft)
[:polyline {:points (points-text draft) :fill "none"
:stroke "#d0ba86" :stroke-width 1}])
(when-not (or drawing? points?) [handles ctx])
(when (and id pts (not drawing?) (not (channel/nothing? pts)))
[:g
[:polygon {:points (points-text pts) :fill "none"
@ -135,7 +270,7 @@
(doall
(for [[i [x y]] (map-indexed vector (pairs pts))]
^{:key i}
[:circle {:cx x :cy y :r 2.6 :fill "#fff1be"
[:circle.vertex {:cx x :cy y :r 2.6 :fill "#fff1be"
:stroke "#161820" :stroke-width 0.7
:on-pointer-down
(fn [event]

View file

@ -203,6 +203,13 @@
y (/ (- (.-clientY e) (.-top box)) (max 1 (.-height box)))]
(cond (< y 0.3) :front (> y 0.7) :back :else :into)))
(def ^:private reveal
"A ref that scrolls the selected row into view, ONE per selection: React calls
a ref again only when it is a different function, so a row is scrolled to when
it becomes the selected one — from the stage, maybe, five rows down — and not
on every render after, which would fight a person scrolling away."
(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]}
selection over solo]
(let [node? (= :node kind)
@ -216,6 +223,7 @@
(if (= :instance node-kind) " drop-into" " drop-group"))))
:style {:padding-left (str (+ 4 (* 11 depth)) "px")}
:title label
:ref (when (and select (= select selection)) (reveal selection))
:on-click #(when select (rf/dispatch [::ui/select select]))
;; An instance's row opens the symbol it places, as a tab.
:on-double-click #(when of (rf/dispatch [::pb/open-symbol of]))}

View file

@ -0,0 +1,123 @@
(ns arthur.domain.gesture-test
(:require [cljs.test :refer [deftest is testing]]
[arthur.domain.channel :as ch]
[arthur.domain.clip :as clip]
[arthur.domain.gesture :as gesture]
[arthur.domain.nest :as nest]
[arthur.domain.node :as node]
[arthur.domain.paint :as paint]
[arthur.domain.palette :as pal]
[arthur.domain.pick :as pick]))
(def ^:private u #uuid "00000000-0000-4000-8000-0000000000e1")
(def ^:private v #uuid "00000000-0000-4000-8000-0000000000e2")
(defn- two-down
"A shape inside :box, placed turned and scaled unevenly in :mid, placed turned
and doubled in :main — so nothing lines up by accident."
[]
(let [turn (fn [c host id pos rot k]
(update-in c [:symbols host :nodes id :channels] merge
{[:xform :pos] (ch/framed pos)
[:xform :rot] (ch/framed rot)
[:xform :scale] (ch/framed k)}))]
(-> (clip/blank)
(assoc-in [:symbols :mid] {:id :mid :frames 40 :nodes {}})
(assoc-in [:symbols :box] {:id :box :frames 30 :nodes {}})
(clip/place-symbol nil :main :mid 10 u nil)
(clip/place-symbol nil :mid :box 2 v nil)
(turn :main u [40 20] (/ js/Math.PI 2) [2 2])
(turn :mid v [5 -3] 0.3 [1.5 0.5])
(paint/new-shape :box :shape 4 [0 0 10 0 5 10] :brow)
(assoc-in [:symbols :box :nodes :shape :channels [:xform :anchor]] (ch/framed [5 3])))))
(defn- drawn [c path]
(partition 2 (take 6 (array-seq (:pts (first (filter #(= path (:node %))
((clip/resolver c nil pal/index-of :main) 16))))))))
(defn- near? [a b] (every? #(< (js/Math.abs %) 1e-9) (map - (flatten a) (flatten b))))
(defn- dragged [c path f vs-fn]
(let [{:keys [sid id frame] :as pl} (nest/placement c nil :main path 16)
v0 (gesture/values (get-in c [:symbols sid :nodes id]) frame)]
(gesture/apply-values c sid id frame (vs-fn pl v0))))
(deftest a-shape-two-symbols-down-moves-under-the-pointer
(doseq [path [[u] [u v] [u v :shape]]]
(let [c (two-down)
moved (dragged c path 16 #(gesture/move %1 %2 [30 30] [37 26]))]
(is (near? (map (fn [[x y]] [(+ x 7) (- y 4)]) (drawn c [u v :shape]))
(drawn moved [u v :shape]))
(str "moving " path " by (7, -4) on the stage moves the shape by (7, -4)")))))
(deftest turning-keeps-the-pivot-where-it-is
(let [c (two-down)
path [u v :shape]
{:keys [world]} (nest/placement c nil :main path 16)
pivot #(let [out (js/Float64Array. 2)]
(vec (array-seq (node/apply-pt! out 0 (:world (nest/placement % nil :main path 16)) 5 3))))
turned (dragged c path 16 #(gesture/turn %2 0.7))]
(is (some? world))
(is (near? (pivot c) (pivot turned)) "the anchor stays put")
(is (not (near? (drawn c path) (drawn turned path))) "and the rest goes round it")))
(deftest scaling-takes-the-grabbed-point-to-the-pointer
(let [c (two-down)
path [u v :shape]
{:keys [world]} (nest/placement c nil :main path 16)
out (js/Float64Array. 2)
at #(vec (array-seq (node/apply-pt! out 0 %1 %2 %3)))
p0 (at world 10 0)
p1 [(+ (first p0) 3) (- (second p0) 5)]
grown (dragged c path 16 #(gesture/scale %1 %2 p0 p1 false))
w2 (:world (nest/placement grown nil :main path 16))]
(is (near? p1 (at w2 10 0))
"the corner grabbed is under the pointer, through a turned, unevenly scaled parent")
(is (near? (at world 5 3) (at w2 5 3)) "about the pivot")))
(deftest a-drag-keys-a-keyed-channel-and-sets-a-framed-one
(let [c (update-in (two-down) [:symbols :mid :nodes v :channels [:xform :pos]]
(constantly (ch/keyed {0 [5 -3] 20 [9 -3]} :linear)))
moved (dragged c [u v] 16 #(gesture/move %1 %2 [0 0] [4 0]))
pos (get-in moved [:symbols :mid :nodes v :channels [:xform :pos]])
rot (dragged c [u v] 16 #(gesture/turn %2 0.1))]
(is (= #{0 4 20} (set (keys (:keys pos))))
"a key on the instance's own frame — 16 of main is 6 of mid, 4 of its own — and the others kept")
(is (= {:animated? false :value 0.4}
(update (get-in rot [:symbols :mid :nodes v :channels [:xform :rot]]) :value
#(/ (js/Math.round (* 10 %)) 10)))
"a channel with no keys has its one value changed")))
(deftest a-measured-transform-is-not-set-by-hand
(is (string? (gesture/refusal {:channels {[:xform :pos] {:animated? true :dense {:stride 2}}}})))
(is (string? (gesture/refusal {:anchors {0 12}})))
(is (nil? (gesture/refusal {:channels {[:xform :pos] (ch/keyed {0 [1 1]})}}))))
(deftest a-click-selects-the-level-figma-would
(let [hit [:a :b :c :shape]]
(testing "choose"
(is (= [:a] (pick/choose nil hit false)) "the thing in the open symbol")
(is (= hit (pick/choose nil hit true)) "⌘ goes to the shape")
(is (= [:a :b] (pick/choose [:a :b] hit false)) "inside what is selected keeps it")
(is (= [:a :x] (pick/choose [:a :b] [:a :x :y] false)) "beside it, at the same depth")
(is (= [:z] (pick/choose [:a :b] [:z :y] false)) "elsewhere, from the top")
(is (nil? (pick/choose [:a] nil false)) "nothing, on nothing"))
(testing "deeper"
(is (= [:a :b] (pick/deeper [:a] hit)))
(is (= hit (pick/deeper hit hit)) "not past the shape")
(is (= [:z] (pick/deeper [:z] hit)) "and not into something else"))))
(deftest the-topmost-op-under-the-point-is-hit
(let [sq (fn [node x0] {:kind :poly :node node :n 4
:pts (js/Float64Array. #js [x0 0 (+ x0 10) 0 (+ x0 10) 10 x0 10])})
ops [(sq :under 0) (sq [u :over] 5) {:kind :disc :node :dot :cx 50 :cy 50 :r 1}]]
(is (= [u :over] (pick/hit ops [7 5])) "the later op is drawn on top")
(is (= [:under] (pick/hit ops [2 5])))
(is (= [:dot] (pick/hit ops [52.5 50])) "a few-pixel shape can be missed by a little")
(is (nil? (pick/hit ops [30 30])))))
(deftest an-instances-box-is-what-its-symbol-draws
(let [c (two-down)
{:keys [frame]} (nest/placement c nil :main [u v] 16)]
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :mid :nodes v]) frame)))
(is (= [0 0 10 10] (pick/local-bounds c nil (get-in c [:symbols :box :nodes :shape]) 4)))))

View file

@ -615,6 +615,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.tl-track { position: relative; }
.tl-label {
/* Scrolled to from the stage: clear of the sticky ruler above. */
scroll-margin-top: var(--ruler);
display: flex;
align-items: center;
gap: 3px;
@ -832,3 +834,11 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
.facts dd.channel .key { padding: 0 3px; color: var(--dim); }
.facts dd.channel .key.keyed { color: var(--fg); }
.facts dd.channel .key.on { color: var(--sel); }
/* The selected node's transform box, in stage pixels (the SVG's viewBox). */
.paint-overlay .handles .box { fill: none; stroke: #e6ca8b; stroke-width: 0.5; stroke-dasharray: 2 1; pointer-events: none; }
.paint-overlay .handles .knob-arm { stroke: #e6ca8b; stroke-width: 0.5; pointer-events: none; }
.paint-overlay .handles .knob { fill: #161820; stroke: #fff1be; stroke-width: 0.6; cursor: grab; }
.paint-overlay .handles .corner { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: nwse-resize; }
.paint-overlay .handles .pivot { stroke: #fff1be; stroke-width: 0.6; pointer-events: none; }
.paint-overlay:focus { outline: none; }