Draw with tools: a pen, a brush that makes polygons, and knockouts

One tool at a time, picked from a strip down the left of the stage or by its
letter, as in Photoshop, Illustrator and Flash: V selects and transforms, P is
the pen, B the brush, E the eraser. The options bar above the stage holds the
tool's settings, and the palette is a grid under the tools with the colour a
new shape gets above it, as Deluxe Paint's was.

The pen's draft is filled into the picture as it is drawn, so the edge on
screen is the pixels the shape will be. Click the first point, Enter, Esc or
leaving the pen closes it; the pen stays the tool. Editing a shape's points is
the pen ON that shape — Figma's vector edit mode — so the separate points mode
is gone: click an edge to add a point, ⌥-click one to delete it, on every key
at once so tweens keep meaning something.

The brush paints a mask, and what it will be is shown while painting: the
stroke is traced round its pixel edges, holes and all, and simplified to a
point every so many pixels of outline by the same function the saved shapes
come from. A hole is bridged into the one ring along a whole-pixel row, which
the fill never samples. Blender's Adjust Last Operation re-traces the last
stroke from what it was made of.

A shape coloured CLEAR is a knockout: its symbol is drawn into a layer of its
own and the knockout clears it, every colour or one. The eraser makes one in
the symbol it starts on, of the colour it starts on, or of every colour with
⌥. A click goes through a knockout to what shows. Previews are drawn in the
stacking context of what they will land in.

The polygon's points no longer stay behind when the shape is moved: they were
read off the saved document while the box handles read the one mid-drag.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

frontend/src/arthur/core.cljs

@@ -17,6 +17,7 @@
             [arthur.ui.index :as index]
             [arthur.ui.player :as player]
             [arthur.ui.shell :as shell]
+            [arthur.ui.tools :as tools]
             [re-frame.core :as rf]
             [reagent.dom.client :as rdc]))
 
@@ -46,6 +47,7 @@
   ;; the blank one, and the blank one is what a bad address leaves on screen.
   (collab/start!)
   (history/install-keys!)
+  (tools/install-keys!)
   (reset! root (rdc/create-root (js/document.getElementById "app")))
   (mount)
   (player/start!))

frontend/src/arthur/db.cljs

@@ -161,7 +161,8 @@
         :selection nil
         :selections []
         :tone      1
-        :tool      nil
+        :tool      :select
+        :brush     6
         :auto-key? false
         :draft     []
         :knobs     {}

frontend/src/arthur/domain/clip.cljs

@@ -245,6 +245,53 @@
    ;; and generated symbols carry their own rate explicitly.
    :symbols {:main {:id :main :frames blank-frames :nodes {}}}})
 
+(defn- op-path [op] (let [n (:node op)] (if (vector? n) n [n])))
+
+(defn- own-span
+  "Where in `ops` the symbol at row path `path` is drawn: the end of its layer
+  when it has one, and the first and last of its own ops."
+  [ops path]
+  (let [own?  #(and (< (count path) (count (op-path %)))
+                    (= path (subvec (op-path %) 0 (count path))))
+        begin (first (keep-indexed #(when (and (= :begin (:kind %2)) (= path (op-path %2))) %1) ops))
+        end   (when begin
+                (reduce (fn [depth i]
+                          (case (:kind (ops i))
+                            :begin (inc depth)
+                            :end   (if (= 1 depth) (reduced i) (dec depth))
+                            depth))
+                        0 (range begin (count ops))))
+        mine  (keep-indexed #(when (own? %2) %1) ops)]
+    {:end (when (integer? end) end) :from (first mine) :to (last mine)}))
+
+(defn- insert-at [ops i & more] (into (into (subvec ops 0 i) more) (subvec ops i)))
+
+(defn atop
+  "`ops` with `op` drawn on top of what the symbol at row path `path` draws —
+  in ITS stacking context, where a shape added to it would land, so what is
+  above that symbol stays above. At the end when it drew nothing."
+  [ops path op]
+  (let [ops (vec ops)
+        {:keys [end to]} (own-span ops path)]
+    (cond end  (insert-at ops end op)
+          to   (insert-at ops (inc to) op)
+          :else (conj ops op))))
+
+(defn in-layer
+  "`ops` with `op` drawn last INSIDE the symbol at row path `path` — in its
+  layer, so a knockout clears only what that symbol drew, as one saved there
+  would. A symbol that has no layer yet is given one around its ops. `ops`
+  unchanged when that symbol drew nothing."
+  [ops path op]
+  (let [ops (vec ops)
+        {:keys [end from to]} (own-span ops path)]
+    (cond
+      end   (insert-at ops end op)
+      from  (-> ops
+                (insert-at (inc to) op {:kind :end :node path})
+                (insert-at from {:kind :begin :node path}))
+      :else ops)))
+
 (defn- transform-op
   "Put a symbol's already resolved mark into its instance's parent space. Its
   name becomes its path of instances down to it, the path its timeline row has."
@@ -358,6 +405,9 @@
                    ;; there used to be. Their resolvers still hold the frame
                    ;; before whenever they were not on.
                    entered (volatile! {})
+                   ;; A symbol that knocks out is drawn into a layer of its own,
+                   ;; so what it clears is only ever its own.
+                   layered? (symbol/knocks? nodes)
                    step (fn [f pre inherited forced]
                           (when context?
                             (vreset! active (or forced
@@ -371,7 +421,7 @@
                           (vreset! entered {})
                           (let [by-id (into {} (map (juxt :node identity))
                                             (own (js/Math.floor f) (js/Math.floor pre)))]
-                            (into []
+                            (cond-> (into (if layered? [{:kind :begin :node []}] [])
                                   (mapcat
                                    (fn [id]
                                      (let [n (get nodes id)]
@@ -406,7 +456,8 @@
                                                          (selection-at n frame nil)))))
                                              []))
                                          (when-let [op (get by-id id)] [op]))))
-                                   ids))))]
+                                   ids))
+                              layered? (conj {:kind :end :node []}))))]
                (reify
                  IFn
                  (-invoke [_ f] (step f (dec f) nil nil))

frontend/src/arthur/domain/outline.cljs

@@ -0,0 +1,235 @@
+(ns arthur.domain.outline
+  "A brush stroke, as pixels and then as polygons.
+
+  Flash's brush: what you paint becomes filled shapes the moment you let go, and
+  the stroke is not kept. Here the stroke is first a MASK — a byte per stage
+  pixel, stamped with the brush's disc as the pointer moves, so what is on screen
+  while painting is exactly the pixels — and on letting go each piece of it is
+  traced round its pixel edges and simplified to as many points as are asked for,
+  as the mouth's ring is.
+
+  The trace walks pixel CORNERS, so before simplifying, a traced ring filled by
+  `raster/fill-poly-buf!` is the mask again exactly.
+
+  A HOLE STAYS A HOLE, and a shape is still one ring. A loop painted round a gap
+  is a piece with a hole in it; the hole is traced as well, and joined to the
+  outside by a HORIZONTAL bridge along a whole-pixel row — out and back along
+  the same line. The fill samples at pixel centres (y + 0.5) and an edge with no
+  height crosses no scanline, so the bridge draws nothing, the even-odd fill
+  leaves the hole empty, and nothing downstream has to know a ring can have
+  one. It is how earcut and the TrueType rasterisers take holes too.
+
+  `pieces` keeps the trace — outside and holes, at full resolution — so the
+  count of points can change after the stroke, and `polygon` is the one place
+  it is simplified and bridged: the preview and the saved shape are the same
+  function's output, so what is on screen while painting is what is kept."
+  (:require [arthur.domain.raster :as raster]))
+
+(defn mask [w h] {:w w :h h :buf (js/Uint8Array. (* w h))})
+
+(defn stamp!
+  "The brush, `size` pixels across, from `[ax ay]` to `[bx by]`: a disc every
+  half radius along the way, so a fast stroke is still one stroke."
+  [m [ax ay] [bx by] size]
+  (let [r     (max 0.5 (/ size 2))
+        steps (max 1 (js/Math.ceil (/ (js/Math.hypot (- bx ax) (- by ay)) (max 0.5 (/ r 2)))))]
+    (dotimes [i (inc steps)]
+      (let [t (/ i steps)]
+        (raster/fill-disc! m (+ ax (* t (- bx ax))) (+ ay (* t (- by ay))) r 1))))
+  m)
+
+(defn- flood!
+  "Label the 4-connected region of pixels whose ink is `ink` from pixel `start`
+  with `id` in `lab`, inside the box `[x0 y0 x1 y1]`. Its size, and whether it
+  reaches the box's edge — a gap that does is outside, not a hole.
+
+  A typed stack and no allocation per pixel: this runs on every pointer move."
+  [^js lab ^js buf w [x0 y0 x1 y1] ink start id ^js stack]
+  (aset lab start id)
+  (aset stack 0 start)
+  (let [top (volatile! 1) size (volatile! 0) edge? (volatile! false)
+        visit! (fn [q] (when (and (zero? (aget lab q)) (== ink (aget buf q)))
+                         (aset lab q id)
+                         (aset stack @top q)
+                         (vswap! top inc)))]
+    (while (pos? @top)
+      (let [p (aget stack (vswap! top dec))
+            x (mod p w) y (quot p w)]
+        (vswap! size inc)
+        (when (or (== x x0) (== x x1) (== y y0) (== y y1)) (vreset! edge? true))
+        (when (< x0 x) (visit! (dec p)))
+        (when (< x x1) (visit! (inc p)))
+        (when (< y0 y) (visit! (- p w)))
+        (when (< y y1) (visit! (+ p w)))))
+    {:size @size :edge? @edge?}))
+
+(def ^:private dirs [[1 0] [0 1] [-1 0] [0 -1]])
+
+(defn- ring
+  "The edge of the region `in?` that starts at pixel `start`, the first of it in
+  raster order, as flat corner points: walked with the region on the right and a
+  point only where the walk turns. Round a piece, that is its outside; round a
+  hole, the inside edge of the piece around it."
+  [w in? start]
+  (let [x0 (mod start w) y0 (quot start w)]
+    ;; Heading east along the start pixel's top edge, the region is below: on the
+    ;; right. At each corner the two pixels ahead decide: the one ahead on the
+    ;; right empty turns right, the one ahead on the left full turns left, and
+    ;; otherwise straight on. Turning right first keeps two regions that touch
+    ;; only at a corner apart, as the 4-connected fill did.
+    ;; The start corner is always a turn — the walk arrives at it heading
+    ;; north up the start pixel's left edge — and is passed only once, because
+    ;; the three pixels round it other than the start are all outside.
+    (loop [x x0 y y0 d 0 out [x0 y0]]
+      (let [[l r] (case d
+                    0 [[x (dec y)] [x y]]
+                    1 [[x y] [(dec x) y]]
+                    2 [[(dec x) y] [(dec x) (dec y)]]
+                    3 [[(dec x) (dec y)] [x (dec y)]])
+            nd (cond (not (apply in? r)) (mod (inc d) 4)
+                     (apply in? l)       (mod (+ d 3) 4)
+                     :else               d)
+            out (if (or (= nd d) (and (= x x0) (= y y0))) out (conj out x y))
+            [dx dy] (dirs nd)
+            nx (+ x dx) ny (+ y dy)]
+        (if (and (= nx x0) (= ny y0))
+          out
+          (recur nx ny nd out))))))
+
+(defn- bounds
+  "`[x0 y0 x1 y1]` round what the mask holds, a pixel wider each way so a gap
+  open to the outside reaches the edge of it — or nil for an empty mask."
+  [{:keys [w h ^js buf]}]
+  (let [b #js [w h -1 -1]]
+    (dotimes [o (* w h)]
+      (when (== 1 (aget buf o))
+        (let [x (mod o w) y (quot o w)]
+          (aset b 0 (min (aget b 0) x)) (aset b 1 (min (aget b 1) y))
+          (aset b 2 (max (aget b 2) x)) (aset b 3 (max (aget b 3) y)))))
+    (when (<= 0 (aget b 2))
+      [(max 0 (dec (aget b 0))) (max 0 (dec (aget b 1)))
+       (min (dec w) (inc (aget b 2))) (min (dec h) (inc (aget b 3)))])))
+
+(defn pieces
+  "Each piece of the mask bigger than `smallest` pixels, biggest first, as
+  `{:outer ring :holes [ring …]}` at full resolution: a hole is a gap inside a
+  piece that does not reach the outside, of more than `smallest` pixels."
+  ([m] (pieces m 2))
+  ([{:keys [w h ^js buf] :as m} smallest]
+   (when-let [[x0 y0 x1 y1 :as box] (bounds m)]
+     (let [lab   (js/Int32Array. (* w h))
+           stack (js/Int32Array. (* w h))
+           ;; Pieces get positive labels and gaps negative ones, in raster
+           ;; order, so each is labelled from its own first pixel.
+           found (let [acc (array)]
+                   (doseq [y (range y0 (inc y1))]
+                     (dotimes [i (inc (- x1 x0))]
+                       (let [o (+ x0 i (* y w))]
+                         (when (zero? (aget lab o))
+                           (let [ink (aget buf o)
+                                 id  (cond-> (inc (.-length acc)) (zero? ink) -)]
+                             (.push acc (assoc (flood! lab buf w box ink o id stack)
+                                               :id id :start o)))))))
+                   (vec acc))
+           in    (fn [id] (fn [x y] (and (< -1 x w) (< -1 y h) (== id (aget lab (+ x (* y w)))))))
+           ;; A hole's first pixel has a pixel of its piece directly above it:
+           ;; anything else above would be the hole itself, and earlier.
+           holes (group-by #(aget lab (- (:start %) w))
+                           (filter #(and (neg? (:id %)) (not (:edge? %)) (< smallest (:size %))) found))]
+       (->> found
+            (filter #(and (pos? (:id %)) (< smallest (:size %))))
+            (sort-by (comp - :size))
+            (mapv (fn [{:keys [id start]}]
+                    {:outer (ring w (in id) start)
+                     :holes (mapv #(ring w (in (:id %)) (:start %)) (get holes id))})))))))
+
+(defn rings
+  "The outside of every piece of the mask, as flat corner points, biggest
+  first."
+  ([m] (rings m 2))
+  ([m smallest] (mapv :outer (pieces m smallest))))
+
+(defn simplify
+  "Ring `pts` cut down to `n` points, a closed ring of at least three:
+  Visvalingam's, which takes away whichever point makes the smallest triangle
+  with its neighbours until `n` are left — so the corners that carry the shape
+  are the last to go, and the count is exactly the one asked for.
+
+  Over typed arrays and a linked ring, because it runs on every pointer move of
+  a brush stroke: taking a point away changes only its two neighbours' areas."
+  [pts n]
+  (let [c    (quot (count pts) 2)
+        n    (max 3 n)]
+    (if (<= c n)
+      (vec pts)
+      (let [xs   (js/Float64Array. c) ys (js/Float64Array. c)
+            prev (js/Int32Array. c) next (js/Int32Array. c)
+            area (js/Float64Array. c)
+            live (js/Uint8Array. c)
+            best (js/Int32Array. 1)
+            tri! (fn [k]
+                   (let [a (aget prev k) d (aget next k)]
+                     (aset area k (js/Math.abs (- (* (- (aget xs k) (aget xs a)) (- (aget ys d) (aget ys a)))
+                                                  (* (- (aget xs d) (aget xs a)) (- (aget ys k) (aget ys a))))))))]
+        (dotimes [k c]
+          (aset xs k (nth pts (* 2 k))) (aset ys k (nth pts (inc (* 2 k))))
+          (aset prev k (mod (dec k) c)) (aset next k (mod (inc k) c))
+          (aset live k 1))
+        (dotimes [k c] (tri! k))
+        (dotimes [_ (- c n)]
+          (let [_ (aset best 0 -1)
+                _ (dotimes [k c]
+                    (when (and (== 1 (aget live k))
+                               (or (neg? (aget best 0)) (< (aget area k) (aget area (aget best 0)))))
+                      (aset best 0 k)))
+                k (aget best 0)
+                a (aget prev k) d (aget next k)]
+            (aset live k 0)
+            (aset next a d) (aset prev d a)
+            (tri! a) (tri! d)))
+        (into [] (mapcat (fn [k] (when (== 1 (aget live k)) [(aget xs k) (aget ys k)]))) (range c))))))
+
+(defn- perimeter [pts]
+  (let [ps (vec (partition 2 pts)) n (count ps)]
+    (reduce + (map (fn [i] (let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))]
+                             (js/Math.hypot (- bx ax) (- by ay))))
+                   (range n)))))
+
+(defn- bridge
+  "Ring `outer` with `hole` joined into it: from the hole's leftmost point,
+  along its row to the nearest edge of `outer` on the left, round the hole, and
+  back. Both are on a whole-pixel row, so the bridge is never filled. See the
+  namespace docstring."
+  [outer hole]
+  (let [hs (vec (partition 2 hole))
+        k  (apply min-key (comp first hs) (range (count hs)))
+        [hx hy] (hs k)
+        os (vec (partition 2 outer))
+        n  (count os)
+        ;; The edge the row meets nearest on the left. A level edge is skipped:
+        ;; running along one draws nothing either.
+        [i qx] (->> (range n)
+                    (keep (fn [i]
+                            (let [[ax ay] (os i) [bx by] (os (mod (inc i) n))]
+                              (when (and (not= ay by) (<= (min ay by) hy (max ay by)))
+                                (let [x (+ ax (* (/ (- hy ay) (- by ay)) (- bx ax)))]
+                                  (when (< x hx) [i x]))))))
+                    (reduce (fn [best c] (if (or (nil? best) (< (second best) (second c))) c best))
+                            nil))]
+    (if i
+      (vec (concat (apply concat (subvec os 0 (inc i)))
+                   [qx hy]
+                   (apply concat (subvec hs k)) (apply concat (subvec hs 0 k))
+                   [hx hy qx hy]
+                   (apply concat (subvec os (inc i)))))
+      outer)))
+
+(defn polygon
+  "Piece `p` of `pieces` as one ring, with a point about every `spacing` pixels
+  of its outline — so a long stroke gets more points than a dab, and a hole gets
+  its own share — and the holes bridged in."
+  [{:keys [outer holes]} spacing]
+  (let [share #(max 3 (js/Math.round (/ (perimeter %) (max 0.01 spacing))))]
+    (reduce bridge (simplify outer (share outer))
+            (sort-by #(apply min (take-nth 2 %))
+                     (map #(simplify % (share %)) holes)))))

frontend/src/arthur/domain/paint.cljs

@@ -53,3 +53,48 @@
     (if (and points (< (inc i) (count points)))
       (assoc-in clip path (-> points (assoc i x) (assoc (inc i) y)))
       clip)))
+
+(defn- every-key
+  "`f` over the points of every key of the shape's geometry."
+  [clip sid id f]
+  (let [path [:symbols sid :nodes id :channels geometry :keys]]
+    (if (and (:paint? (get-in clip [:symbols sid :nodes id])) (map? (get-in clip path)))
+      (update-in clip path update-vals f)
+      clip)))
+
+(defn insert-vertex
+  "A new point after point `i`, a fraction `t` of the way along the edge to the
+  next, on EVERY key: a point's index is what it is across keys, so a tween
+  between two keys only means anything while they have the same points. The
+  shape does not change on any key."
+  [clip sid id i t]
+  (every-key clip sid id
+             (fn [pts]
+               (let [n (quot (count pts) 2)
+                     j (mod (inc i) n)
+                     at #(+ (nth pts (+ (* 2 i) %))
+                            (* t (- (nth pts (+ (* 2 j) %)) (nth pts (+ (* 2 i) %)))))]
+                 (if (< i n)
+                   (-> (subvec pts 0 (* 2 (inc i)))
+                       (conj (at 0) (at 1))
+                       (into (subvec pts (* 2 (inc i)))))
+                   pts)))))
+
+(defn delete-vertex
+  "Point `i` gone from every key, as `insert-vertex` adds one. A triangle keeps
+  its three."
+  [clip sid id i]
+  (every-key clip sid id
+             (fn [pts]
+               (if (and (< 6 (count pts)) (< (* 2 i) (count pts)))
+                 (into (subvec pts 0 (* 2 i)) (subvec pts (* 2 (inc i))))
+                 pts))))
+
+(defn set-points
+  "Key `key-frame` of the shape is `points`, whatever it held: a stroke being
+  re-simplified to another count."
+  [clip sid id key-frame points]
+  (let [path [:symbols sid :nodes id :channels geometry :keys key-frame]]
+    (if (get-in clip path)
+      (assoc-in clip path points)
+      clip)))

frontend/src/arthur/domain/pick.cljs

@@ -49,14 +49,9 @@
             (and (<= (js/Math.abs (- x cx)) h) (<= (js/Math.abs (- y cy)) h)))
     false))
 
-(defn hit
+(defn- op-bounds [{:keys [kind pts n cx cy r size knock]}]
-  "The row path of the topmost op in `ops`, in draw order, at stage point `[x y]`,
+  ;; A knockout draws nothing, so a marquee does not catch it.
-  or nil."
+  (case (when-not knock kind)
-  [ops [x y]]
-  (some #(when (on? % x y) (path-of %)) (rseq (vec ops))))
-
-(defn- op-bounds [{:keys [kind pts n cx cy r size]}]
-  (case kind
     :poly (reduce (fn [b i]
                     (let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))]
                       (if b (let [[x0 y0 x1 y1] b]
@@ -83,6 +78,27 @@
 (defn- prefix? [a b]
   (and (<= (count a) (count b)) (= a (subvec b 0 (count a)))))
 
+(defn hit-op
+  "The topmost op in `ops`, in draw order, that SHOWS at stage point `[x y]`, or
+  nil. A knockout is never hit: it is a hole, and a click in it is a click on
+  whatever shows through — so it hides the ops beneath it in its own symbol, of
+  the colour it clears."
+  [ops [x y]]
+  (:op (reduce (fn [holes op]
+                 (cond
+                   (not (on? op x y)) holes
+                   (:knock op) (conj holes [(pop (path-of op)) (:knock op)])
+                   (some (fn [[in k]] (and (prefix? in (path-of op))
+                                           (or (neg? k) (== k (:color op)))))
+                         holes) holes
+                   :else (reduced {:op op})))
+               [] (rseq (vec ops)))))
+
+(defn hit
+  "The row path of the topmost op that shows at stage point `[x y]`, or nil."
+  [ops point]
+  (some-> (hit-op ops point) path-of))
+
 (defn choose
   "The row path a click on `hit` selects, with `selected` the one selected now."
   [selected hit deep?]

frontend/src/arthur/domain/raster.cljs

@@ -24,6 +24,46 @@
   (.fill buf index)
   r)
 
+;; ---------------------------------------------------------------------------
+;; layers and knockouts
+;;
+;; A symbol holding a KNOCKOUT shape is drawn into a layer of its own first —
+;; Flash's Erase blend inside a symbol set to Layer. A layer is a raster with a
+;; `:cov` byte per pixel saying whether anything is there; a knockout clears
+;; coverage, of every colour or of one, and the layer lands on the one under it
+;; only where it is covered. The main raster has no `:cov` and is always
+;; covered.
+;;
+;; `knock` is nil for an ordinary fill, -1 for a knockout of every colour, and
+;; an index for a knockout of that colour only.
+
+(defn- plot! [^js buf cov o index knock]
+  (if (nil? knock)
+    (do (aset buf o index)
+        (when cov (aset cov o 1)))
+    (when (and cov (or (neg? knock) (== (aget buf o) knock)))
+      (aset cov o 0))))
+
+(defn- shows?
+  "Does pixel `o` hold `over`? A stencil only matches what is really there, so
+  an uncovered pixel of a layer holds nothing."
+  [^js buf cov o over]
+  (or (nil? over)
+      (and (or (nil? cov) (== 1 (aget cov o))) (== (aget buf o) over))))
+
+(defn layer [w h]
+  {:w w :h h :buf (js/Uint8Array. (* w h)) :cov (js/Uint8Array. (* w h))})
+
+(defn composite!
+  "Land layer `l` on raster `r` wherever `l` is covered."
+  [{:keys [buf cov] :as r} l]
+  (let [^js lb (:buf l) ^js lc (:cov l)]
+    (dotimes [o (.-length lb)]
+      (when (== 1 (aget lc o))
+        (aset buf o (aget lb o))
+        (when cov (aset cov o 1)))))
+  r)
+
 (defn fill-poly-buf!
   "Even-odd scanline fill of a polygon held FLAT in `pts` as [x0 y0 x1 y1 …],
   using the first `n` points. Samples at pixel centres (y + 0.5), so a polygon
@@ -35,8 +75,9 @@
   allocation is the only thing that will make this stutter.
 
   `pts` may be a CLJS vector or any typed array; scanline crossings are collected
-  into a plain JS array and sorted in place."
+  into a plain JS array and sorted in place. `knock` is as `plot!`'s."
-  [{:keys [w h buf] :as r} pts n index]
+  ([r pts n index] (fill-poly-buf! r pts n index nil))
+  ([{:keys [w h buf cov] :as r} pts n index knock]
   (when (>= n 3)
     (let [px   (fn [i] (if (vector? pts) (-nth pts (* 2 i)) (aget pts (* 2 i))))
           py   (fn [i] (if (vector? pts) (-nth pts (inc (* 2 i))) (aget pts (inc (* 2 i)))))
@@ -78,8 +119,8 @@
                     x-to   (min (dec w) (js/Math.floor (- xb 0.5)))
                     row    (* y w)]
                 (dotimes [dx (inc (- x-to x-from))]
-                  (aset buf (+ row x-from dx) index)))))))))
+                  (plot! buf cov (+ row x-from dx) index knock)))))))))
-  r)
+  r))
 
 (defn fill-poly!
   "`fill-poly-buf!` over a seq of {:x :y} points.
@@ -99,8 +140,9 @@
   any radius, including mid-blink when the opening is a two-pixel sliver, so
   the lid crops the iris for free instead of the gaze range needing a
   clamp that would flatten the performance at the extremes."
-  ([r cx cy rad index] (fill-disc! r cx cy rad index nil))
+  ([r cx cy rad index] (fill-disc! r cx cy rad index nil nil))
-  ([{:keys [w h buf] :as r} cx cy rad index over]
+  ([r cx cy rad index over] (fill-disc! r cx cy rad index over nil))
+  ([{:keys [w h buf cov] :as r} cx cy rad index over knock]
    (let [rr (* rad rad)
          y0 (max 0 (js/Math.floor (- cy rad)))
          y1 (min (dec h) (js/Math.ceil (+ cy rad)))
@@ -114,8 +156,8 @@
                dy (- (+ y 0.5) cy)]
            (when (<= (+ (* dx dx) (* dy dy)) rr)
              (let [o (+ (* y w) x)]
-               (when (or (nil? over) (= (aget buf o) over))
+               (when (shows? buf cov o over)
-                 (aset buf o index)))))))
+                 (plot! buf cov o index knock)))))))
      r)))
 
 (defn fill-rect!
@@ -132,8 +174,9 @@
   on every frame. Round the extents instead and a fractional centre gives you
   three pixels on one frame and four on the next, which reads as the pupil
   breathing."
-  ([r cx cy size index] (fill-rect! r cx cy size index nil))
+  ([r cx cy size index] (fill-rect! r cx cy size index nil nil))
-  ([{:keys [w h buf] :as r} cx cy size index over]
+  ([r cx cy size index over] (fill-rect! r cx cy size index over nil))
+  ([{:keys [w h buf cov] :as r} cx cy size index over knock]
    (let [size (js/Math.round size)]
      (when (>= size 1)
        (let [x0 (js/Math.round (- cx (/ size 2)))
@@ -143,8 +186,8 @@
          (dotimes [iy (- yb ya)]
            (dotimes [ix (- xb xa)]
              (let [o (+ (* (+ ya iy) w) xa ix)]
-               (when (or (nil? over) (= (aget buf o) over))
+               (when (shows? buf cov o over)
-                 (aset buf o index))))))))
+                 (plot! buf cov o index knock))))))))
    r))
 
 (def ^:private little-endian?
@@ -223,6 +266,27 @@
                (aset d (+ o 3) 255))))))
      {:width W :height H :data d})))
 
+(defn- fill-mask!
+  "Every pixel set in `mask`, a byte per stage pixel: a brush stroke as it is
+  being painted, before it is a polygon."
+  [{:keys [buf cov] :as r} ^js mask index knock]
+  (dotimes [o (.-length mask)]
+    (when (== 1 (aget mask o))
+      (plot! buf cov o index knock)))
+  r)
+
+;; One layer per depth of nesting, reused from frame to frame, as the resolver
+;; reuses its point buffers.
+(defonce ^:private layers (atom {}))
+
+(defn- layer-at [depth w h]
+  (let [l (get @layers depth)]
+    (if (and l (= w (:w l)) (= h (:h l)))
+      l
+      (let [l (layer w h)]
+        (swap! layers assoc depth l)
+        l))))
+
 (defn draw-ops!
   "Paint a list of draw ops, in the order given, into the raster. Stage 7.
 
@@ -230,12 +294,25 @@
   space points and a PALETTE INDEX, and the rasteriser knows nothing about nodes,
   channels, time maps or provenance. Everything above here can be rearranged
   without touching a scanline, and a painted cel and a rotoscoped mouth arrive
-  here indistinguishable from each other, which is the point."
+  here indistinguishable from each other, which is the point.
-  [r ops]
+
-  (doseq [{:keys [kind pts n color stencil cx cy size] :as op} ops]
+  `:begin` and `:end` bracket the ops of a symbol drawn into a layer of its own;
-    (case kind
+  `:knock` on an op makes it a knockout. See `plot!`."
-      :poly (fill-poly-buf! r pts n color)
+  [{:keys [w h] :as r} ops]
-      :disc (fill-disc! r cx cy (:r op) color stencil)
+  (reduce
-      :rect (fill-rect! r cx cy size color stencil)
+   (fn [stack {:keys [kind pts n color stencil cx cy size knock] :as op}]
-      (throw (ex-info "draw op kind is not rasterisable" {:op (dissoc op :pts)}))))
+     (let [top (peek stack)]
+       (case kind
+         :begin (let [l (layer-at (count stack) w h)]
+                  (.fill (:cov l) 0)
+                  (conj stack l))
+         :end   (if (< 1 (count stack))
+                  (let [s (pop stack)] (composite! (peek s) top) s)
+                  stack)
+         :poly  (do (fill-poly-buf! top pts n color knock) stack)
+         :disc  (do (fill-disc! top cx cy (:r op) color stencil knock) stack)
+         :rect  (do (fill-rect! top cx cy size color stencil knock) stack)
+         :mask  (do (fill-mask! top (:mask op) color knock) stack)
+         (throw (ex-info "draw op kind is not rasterisable" {:op (dissoc op :pts)})))))
+   [r] ops)
   r)

frontend/src/arthur/domain/symbol.cljs

@@ -280,6 +280,25 @@
     (nil? k)     255
     :else        (get palette k 255)))
 
+(defn knockout?
+  "Is colour `c` a KNOCKOUT rather than a tone? `:clear` clears every colour
+  beneath it in its symbol, `[:clear tone]` clears that tone only. See
+  `raster/plot!`."
+  [c]
+  (or (= :clear c) (and (vector? c) (= :clear (first c)))))
+
+(defn- knock-index [palette c]
+  (if (= :clear c) -1 (colour-index palette (second c))))
+
+(defn knocks?
+  "Does any node in `nodes` knock out, on any frame? Such a symbol is drawn into
+  a layer of its own."
+  [nodes]
+  (some (fn [[_ n]]
+          (let [c (get-in n [:channels [:style :color]])]
+            (some knockout? (cons (:value c) (vals (:keys c))))))
+        nodes))
+
 ;; ---------------------------------------------------------------------------
 ;; the walk
 
@@ -401,7 +420,13 @@
   "Emit geometry in the symbol's space. Rect sizes stay fractional until
   rasterization, so enclosing symbol transforms can still scale them."
   [{:keys [palette buf-for]} n {:keys [m rd]} base]
-  (let [colour #(colour-index palette (rd [:style :color]))]
+  ;; Read only by the kinds that have a colour: a group or an instance has no
+  ;; `[:style :color]` to read.
+  (let [paint  (fn [op]
+                 (let [c (rd [:style :color])]
+                   (if (knockout? c)
+                     (assoc op :knock (knock-index palette c) :color 0)
+                     (assoc op :color (colour-index palette c)))))]
     (case (:kind n)
       :group nil
       :instance nil
@@ -415,23 +440,21 @@
               (node/apply-pt! out k m
                               (ch/component pts (* 2 k))
                               (ch/component pts (inc (* 2 k)))))
-            (assoc base :kind :poly :pts out :n np :color (colour)))))
+            (paint (assoc base :kind :poly :pts out :n np)))))
 
       :disc
       (let [rad (rd [:geom :radius])]
         (when-not (ch/nothing? rad)
-          (assoc base :kind :disc
+          (paint (assoc base :kind :disc
-                 :cx (aget m 4) :cy (aget m 5)
+                        :cx (aget m 4) :cy (aget m 5)
-                 :r (* rad (node/mean-scale m))
+                        :r (* rad (node/mean-scale m))))))
-                 :color (colour))))
 
       :rect
       (let [size (rd [:geom :size])]
         (when-not (ch/nothing? size)
-          (assoc base :kind :rect
+          (paint (assoc base :kind :rect
-                 :cx (aget m 4) :cy (aget m 5)
+                        :cx (aget m 4) :cy (aget m 5)
-                 :size (* size (node/mean-scale m))
+                        :size (* size (node/mean-scale m))))))
-                 :color (colour))))
 
       (throw (ex-info "node kind is not implemented"
                       {:node (:id n) :kind (:kind n)})))))

frontend/src/arthur/events/ui.cljs

@@ -23,6 +23,7 @@
             [arthur.domain.creation :as creation]
             [arthur.domain.gesture :as gesture]
             [arthur.domain.nest :as nest]
+            [arthur.domain.outline :as outline]
             [arthur.domain.node :as node]
             [arthur.domain.palette :as pal]
             [arthur.domain.span :as span]
@@ -70,7 +71,7 @@
   (-> db
       (assoc-in [:ui :selection] selection)
       (assoc-in [:ui :selections] (if selection [selection] []))
-      (update :ui dissoc :points :retry)))
+      (update :ui dissoc :retry)))
 
 (rf/reg-event-db ::select (fn [db [_ selection]] (selected db selection)))
 
@@ -427,7 +428,7 @@
       (-> db
           (assoc-in [:ui :selection] primary)
           (assoc-in [:ui :selections] addresses)
-          (update :ui dissoc :points :retry))
+          (update :ui dissoc :retry))
       (-> db
           (assoc-in [:ui :selection] nil)
           (assoc-in [:ui :selections] [])))))
@@ -500,24 +501,71 @@
 (rf/reg-event-db ::duplicate-unique (fn [db _] (duplicate-selected db true)))
 
 ;; ---------------------------------------------------------------------------
-;; drawing a polygon
+;; drawing
 ;;
-;; Three events and a vector of numbers. The draft is in app-db rather than in a
+;; THE TOOL IS WHAT A DRAG ON THE STAGE DOES; the selection is what it does it
-;; ratom because the stage draws it, the palette colours it and the params pane
+;; to. One tool at a time, each with a key, as in Photoshop, Illustrator and
-;; reports its vertex count — and because a half-drawn shape surviving a hot
+;; Flash: V selects and transforms, P is the pen, B the brush, E the eraser.
-;; reload is worth more than the handful of dispatches it costs. Clicks are rare;
+;; Editing a shape's points is the pen ON that shape — Figma's vector edit
-;; this is not the drag path.
+;; mode — so there is no separate points mode to be in.
+;;
+;; The pen's draft is in app-db rather than in a ratom because the stage draws
+;; it, the canvas fills it and the options bar counts it — and because a
+;; half-drawn shape surviving a hot reload is worth more than the handful of
+;; dispatches it costs. Clicks are rare; this is not the drag path. `:hover` is
+;; where the pointer is while a draft is open, so the canvas can fill the shape
+;; the next click would make.
+
+(def tools #{:select :pen :brush :eraser})
+
+(declare finishing-polygon)
+
+(rf/reg-event-db
+ ::set-tool
+ ;; Leaving the pen commits what it was drawing, as Esc does: an unfinished
+ ;; polygon is not a thing the document can hold.
+ (fn [db [_ tool]]
+   (if (contains? tools tool)
+     (-> (if (= tool (get-in db [:ui :tool])) db (finishing-polygon db))
+         (update :ui merge {:tool tool :draft []})
+         (update :ui dissoc :hover))
+     db)))
 
 (rf/reg-event-db
  ::cancel-polygon
- (fn [db _] (update db :ui merge {:tool nil :draft []})))
+ (fn [db _] (update (assoc-in db [:ui :draft] []) :ui dissoc :hover)))
 
 (rf/reg-event-db
- ::add-draft-point
+ ::hover
- (fn [db [_ x y]]
+ (fn [db [_ p]] (if p (assoc-in db [:ui :hover] p) (update db :ui dissoc :hover))))
-   (if (= :polygon (get-in db [:ui :tool]))
+
-     (update-in db [:ui :draft] into [x y])
+(def tool-keys #{"v" "p" "b" "e" "[" "]" "enter" "escape"})
-     db)))
+
+(rf/reg-event-fx
+ ::tool-key
+ ;; A key from `ui/tools`, decided here against the state it changes, and
+ ;; passed on as the event the button for it would send.
+ (fn [{:keys [db]} [_ k]]
+   (let [{:keys [tool draft brush]} (:ui db)
+         size (or brush 6)
+         by   (if (< size 10) 1 2)
+         ev   (case k
+                "v" [::set-tool :select]
+                "p" [::set-tool :pen]
+                "b" [::set-tool :brush]
+                "e" [::set-tool :eraser]
+                "[" [::brush-size (- size by)]
+                "]" [::brush-size (+ size by)]
+                "enter"  (cond (seq draft) [::finish-polygon]
+                               (#{:select nil} tool) [::set-tool :pen])
+                "escape" (when (= :pen tool)
+                           (if (seq draft) [::finish-polygon] [::set-tool :select]))
+                nil)]
+     (if ev {:fx [[:dispatch ev]]} {}))))
+
+(rf/reg-event-db
+ ::brush-size
+ (fn [db [_ size]] (assoc-in db [:ui :brush] (-> size js/Math.round (max 1) (min 64)))))
 
 (defn new-lane-drawing
   "Create the one-frame drawing cel implied by drawing with a lane row active.
@@ -585,56 +633,135 @@
                              (peek (:path landing)) (:path landing)]))
 
               :else db)]
-    (if (:refused landing)
+    (if (:refused landing) db' (assoc-in db' [:ui :draft] []))))
-      db'
-      (update db' :ui merge {:tool :polygon :draft []}))))
 
 (rf/reg-event-db
- ::begin-polygon
+ ::add-draft-point
- (fn [db _] (beginning-polygon db)))
+ ;; The first point is where the drawing begins: a lane gets its new cel then,
+ ;; so it is the current one while the rest are placed.
+ (fn [db [_ x y]]
+   (if (= :pen (get-in db [:ui :tool]))
+     (update-in (if (seq (get-in db [:ui :draft])) db (beginning-polygon db))
+                [:ui :draft] (fnil into []) [x y])
+     db)))
+
+(defn- landing-into
+  "Where shapes drawn on the stage go, and their points re-expressed there:
+  `{:clip :sid :frame :down :rings}` with each of `rings` in that symbol's
+  coordinates, or `{:refused why}`. `down` is the row path to draw inside, or
+  nil for the creation target, which a lane makes a new cel for."
+  [db down rings]
+  (let [open (get-in db [:ui :open])
+        {clip :clip st :store} (store/entry (:clip/current db))
+        landing (if down {:clip clip :path down} (polygon-landing clip st db))
+        source  (:clip landing)
+        inside  #(nest/drawn-inside source st open (:path landing) (editing-frame db source) %)
+        at      (when-not (:refused landing) (inside []))]
+    (cond
+      (:refused landing) landing
+      (nil? (:sid at)) {:refused (if (:lane? landing)
+                                   "this sequence is not on screen at this frame"
+                                   "what you are drawing into is not on screen at this frame")}
+      :else {:clip source :sid (:sid at) :frame (:frame at) :down (:path landing)
+             :rings (mapv (comp :pts inside) rings)})))
+
+(defn- finishing-polygon
+  "`db` with the pen's draft committed as a shape, when it has three points."
+  [db]
+  (let [draft (get-in db [:ui :draft])
+        {:keys [refused clip sid frame down rings]} (when (<= 6 (count draft))
+                                                       (landing-into db nil [draft]))]
+    (cond
+      (< (count draft) 6) (update (assoc-in db [:ui :draft] []) :ui dissoc :hover)
+      refused (update db :project merge {:status refused})
+      ;; `random-uuid` is the one impurity in this namespace, and it is here
+      ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells
+      ;; out: a node's id is its identity in the saved document, so the pure
+      ;; layer must be handed one rather than invent one. If replaying the event
+      ;; log ever has to reproduce a document exactly, this becomes a cofx.
+      ;;
+      ;; NOTHING IS OPENED HERE. Expansion is the twist triangle's business; the
+      ;; shape is selected and on the stage, which is where you were looking.
+      :else
+      (let [id (keyword (str "paint-" (random-uuid)))]
+        (-> db
+            (edit/transaction
+             (fn [_] (paint/new-shape clip sid id frame (first rings) (get-in db [:ui :tone]))))
+            (assoc-in [:ui :draft] [])
+            (update :ui dissoc :hover :last)
+            (selected [:node sid id (conj down id)]))))))
+
+;; Closing on the first point, Enter, Esc and leaving the pen all commit, as in
+;; Figma; the pen stays the tool, as it does in Photoshop.
+(rf/reg-event-db ::finish-polygon (fn [db _] (finishing-polygon db)))
+
+;; ---------------------------------------------------------------------------
+;; brush and eraser
+;;
+;; A stroke arrives as the pieces `domain/outline` traced off its mask, in stage
+;; pixels, holes and all. Each becomes a shape with a point every `:spacing`
+;; pixels of its outline — so a long stroke gets more than a dab. What it was
+;; made from is kept in `[:ui :last]`, Blender's Adjust Last Operation, so the
+;; spacing can be changed afterwards from the trace rather than from the points
+;; already thrown away, until something else is done.
+
+(def default-spacing 6)
+
+(defn- stroke-points [pieces spacing]
+  (mapv #(outline/polygon % spacing) pieces))
 
 (rf/reg-event-db
- ::finish-polygon
+ ::spacing
- ;; The drawing already exists from `::begin-polygon`; finishing commits only
+ (fn [db [_ spacing]] (assoc-in db [:ui :spacing] (-> spacing (max 1) (min 40)))))
- ;; the shape, so cancelling a draft does not undo the drawing that was started.
+
- (fn [db _]
+(rf/reg-event-db
-   (let [draft (get-in db [:ui :draft])
+ ::stroke
-         open  (get-in db [:ui :open])
+ ;; `down` and `colour` are the eraser's: the symbol the stroke began in, and
-         {clip :clip st :store} (store/entry (:clip/current db))
+ ;; the knockout it makes there. The brush draws in the tone, into the creation
-         landing (polygon-landing clip st db)
+ ;; target, as the pen does.
-         source  (:clip landing)
+ (fn [db [_ {:keys [pieces down colour]}]]
-         down    (:path landing)
+   (let [spacing (get-in db [:ui :spacing] default-spacing)
-         {:keys [sid frame pts]}
+         {:keys [refused clip sid frame] :as at} (when (seq pieces)
-         (when-not (:refused landing)
+                                                    (landing-into db down (stroke-points pieces spacing)))
-           (nest/drawn-inside source st open down (editing-frame db source) draft))]
+         ids (vec (repeatedly (count pieces) #(keyword (str "paint-" (random-uuid)))))]
      (cond
-       (< (count draft) 6) db
+       (empty? pieces) db
-       (:refused landing) (update db :project merge {:status (:refused landing)})
+       refused (update db :project merge {:status refused})
-       (nil? sid)
-       (update db :project merge
-               {:status (if (:lane? landing)
-                          "this sequence is not on screen at this frame"
-                          "what you are drawing into is not on screen at this frame")})
-       ;; `random-uuid` is the one impurity in this namespace, and it is here
-       ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells
-       ;; out: a node's id is its identity in the saved document, so the pure
-       ;; layer must be handed one rather than invent one. If replaying the event
-       ;; log ever has to reproduce a document exactly, this becomes a cofx.
        :else
-       (let [id (keyword (str "paint-" (random-uuid)))]
+       (cond-> (-> db
-         ;; NOTHING IS OPENED HERE. Finishing a shape used to expand every row
+                   (edit/transaction
-         ;; between the open symbol and the new shape, which inside a lane meant
+                    (fn [_] (reduce (fn [c [id pts]]
-         ;; tearing the lane's one row open into its portal, that clip's
+                                      (paint/new-shape c sid id frame pts
-         ;; channels and every shape already in the drawing — a dozen rows, in
+                                                       (or colour (get-in db [:ui :tone]))))
-         ;; answer to a gesture that said nothing about the outline. Expansion
+                                    clip (map vector ids (:rings at)))))
-         ;; is the twist triangle's business and nobody else's; the shape is
+                   (assoc-in [:ui :last] {:kind (if down :eraser :brush) :pieces pieces
-         ;; selected and on the stage with handles on it, which is where you
+                                          :spacing spacing
-         ;; were looking.
+                                          :down (:down at) :sid sid :frame frame :ids ids}))
-         (-> db
+         (nil? down) (selected [:node sid (peek ids) (conj (:down at) (peek ids))]))))))
-             (edit/transaction
+
-              (fn [_] (paint/new-shape source sid id frame pts (get-in db [:ui :tone]))))
+(rf/reg-event-db
-             (update :ui merge {:tool nil :draft []})
+ ::adjust-last
-             (selected [:node sid id (conj down id)])))))))
+ ;; The last stroke's spacing, and the next one's: one setting, in the options
+ ;; bar and in the panel, as Blender's redo panel writes back to the tool.
+ (fn [db [_ spacing]]
+   (let [{:keys [pieces down sid frame ids]} (get-in db [:ui :last])
+         at (when pieces (landing-into db down (stroke-points pieces spacing)))]
+     (if (and pieces (= sid (:sid at)))
+       (-> db
+           (assoc-in [:ui :spacing] spacing)
+           (assoc-in [:ui :last :spacing] spacing)
+           (edit/transaction
+            (fn [c] (reduce (fn [c [id pts]] (paint/set-points c sid id frame pts))
+                            c (map vector ids (:rings at))))))
+       db))))
+
+(rf/reg-event-db
+ ::insert-vertex
+ (fn [db [_ sid id i t]] (edit/transaction db #(paint/insert-vertex % sid id i t))))
+
+(rf/reg-event-db
+ ::delete-vertex
+ (fn [db [_ sid id i]] (edit/transaction db #(paint/delete-vertex % sid id i))))
 
 (rf/reg-event-db
  ::set-knob
@@ -977,14 +1104,6 @@
        (: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)))
@@ -1067,17 +1186,20 @@
 
 (rf/reg-event-db
  ::delete-selected
+ ;; Backspace while drawing takes the last point back, as in Illustrator.
  (fn [db _]
-   (let [primary (get-in db [:ui :selection])
+   (if (seq (get-in db [:ui :draft]))
-         many (vec (get-in db [:ui :selections]))
+     (update-in db [:ui :draft] #(subvec % 0 (- (count %) 2)))
-         selections (if (some #{primary} many) many (if primary [primary] []))
+     (let [primary (get-in db [:ui :selection])
-         nodes (distinct (keep (fn [[kind sid id]] (when (= :node kind) [sid id])) selections))]
+           many (vec (get-in db [:ui :selections]))
-     (if (seq nodes)
+           selections (if (some #{primary} many) many (if primary [primary] []))
-       (-> db
+           nodes (distinct (keep (fn [[kind sid id]] (when (= :node kind) [sid id])) selections))]
-           (edit/transaction #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes))
+       (if (seq nodes)
-           (assoc-in [:ui :selection] nil)
+         (-> db
-           (assoc-in [:ui :selections] []))
+             (edit/transaction #(reduce (fn [c [sid id]] (nest/delete-node c sid id)) % nodes))
-       db))))
+             (assoc-in [:ui :selection] nil)
+             (assoc-in [:ui :selections] []))
+         db)))))
 
 (rf/reg-event-db
  ::restack

frontend/src/arthur/subs/ui.cljs

@@ -29,15 +29,28 @@
 (rf/reg-sub ::clipboard (fn [db _] (get-in db [:ui :clipboard])))
 (rf/reg-sub ::retry (fn [db _] (get-in db [:ui :retry])))
 (rf/reg-sub ::tone      (fn [db _] (get-in db [:ui :tone])))
-(rf/reg-sub ::tool      (fn [db _] (get-in db [:ui :tool])))
+(rf/reg-sub ::tool      (fn [db _] (or (get-in db [:ui :tool]) :select)))
 (rf/reg-sub ::auto-key? (fn [db _] (boolean (get-in db [:ui :auto-key?]))))
 (rf/reg-sub ::draft     (fn [db _] (get-in db [:ui :draft])))
+(rf/reg-sub ::hover     (fn [db _] (get-in db [:ui :hover])))
+(rf/reg-sub ::brush     (fn [db _] (get-in db [:ui :brush] 6)))
+(rf/reg-sub ::spacing   (fn [db _] (get-in db [:ui :spacing] 6)))
+(rf/reg-sub ::last-op   (fn [db _] (get-in db [:ui :last])))
+
 (rf/reg-sub ::convert   (fn [db _] (get-in db [:ui :convert])))
 (rf/reg-sub ::drop      (fn [db _] (get-in db [:ui :drop])))
 (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
+ ::last
+ :<- [::last-op]
+ :<- [::render/clip]
+ ;; The last stroke, while what it made is still there to adjust: an undo takes
+ ;; the panel away with the shapes.
+ (fn [[{:keys [sid ids] :as op} clip] _]
+   (when (and op (get-in clip [:symbols sid :nodes (first ids)])) op)))
 
 (rf/reg-sub
  ::selected-node
@@ -56,17 +69,18 @@
  ::selected-local
  :<- [::selected-node]
  :<- [::selection]
+ :<- [::render/clip]
  :<- [::render/clip-id]
  :<- [::render/open]
  :<- [::render/open-frame]
- (fn [[[_ id n] [_ _ _ path] clip-id open f] _]
+ (fn [[[_ id n] [_ _ _ path] clip clip-id open f] _]
    ;; `nest/inside` the selected node, from the open symbol: its own frame, the
    ;; matrix from its coordinates to the stage's, and the time map from the open
    ;; symbol's frames to its own. A selection made on the stage has no path and
-   ;; names a node in the open symbol.
+   ;; names a node in the open symbol. From the clip as it is mid-drag, as
+   ;; `::selected-placement` is, so the points go with the shape they belong to.
    (when n
-     (let [{clip :clip st :store} (store/entry clip-id)]
+     (nest/inside clip (:store (store/entry clip-id)) open (or path [id]) f))))
-       (nest/inside clip st open (or path [id]) f)))))
 
 (rf/reg-sub
  ::creation-target

frontend/src/arthur/ui/palette.cljs

@@ -1,41 +1,58 @@
 (ns arthur.ui.palette
-  "The bar above the stage: the tone a new shape gets, and the tool that makes
+  "The palette: a grid of the open palette's slots under the tools, and the
-  one.
+  palette asset it is, in the options bar.
+
+  A GRID BESIDE THE TOOLS, as Deluxe Paint and Animator Pro put theirs — the
+  indexed tools this one descends from — rather than a strip of dots across the
+  top: a palette is a fixed table of slots, and a grid shows it as one. Over the
+  grid sits the colour a new shape gets, big, as Photoshop's foreground chip.
 
   Shapes store only the selected local slot number. Palette identity is supplied
   by the symbol tree, and the colour input edits the project palette asset.
+  Picking a slot also recolours whatever is selected; picking CLEAR makes it a
+  knockout — select a lens, pick clear, and it is a hole.
 
   The footage switch is NOT here. It is a viewing aid rather than something you
-  set before you draw, so it is a section of the inspector — one that is there
+  set before you draw, so it is a section of the inspector. See `ui/params`."
-  for whatever the open symbol has faces of, so it still does not come and go
+  (:require [arthur.domain.node :as node]
-  with the selection. See `ui/params`."
+            [arthur.domain.palette :as pal]
-  (:require [arthur.domain.palette :as pal]
-            [arthur.domain.node :as node]
-            [arthur.events.ui :as ui]
             [arthur.events.project :as project]
+            [arthur.events.ui :as ui]
             [arthur.subs.render :as render]
             [arthur.subs.ui :as sub]
-            [arthur.ui.layout :as layout]
             [re-frame.core :as rf]))
 
 (rf/reg-sub ::chosen (fn [db _] (get-in db [:ui :palette])))
 
+(rf/reg-event-db ::select (fn [db [_ id]] (assoc-in db [:ui :palette] id)))
+
+(defn- shown
+  "The palette asset the grid shows: the one chosen, or the project's default."
+  []
+  (let [clip   @(rf/subscribe [::render/clip])
+        chosen @(rf/subscribe [::chosen])
+        pid    (if (contains? (:palettes clip) chosen) chosen (pal/default-palette-id clip))]
+    [clip pid (get (pal/palettes clip) pid)]))
+
+(defn- pick!
+  "Make `tone` the colour new shapes get, and recolour what is selected."
+  [tone placements]
+  (rf/dispatch [::ui/set-tone tone])
+  (let [edits (into [] (keep (fn [{:keys [sid id node frame]}]
+                               (when (contains? (get node/valid-paths (:kind node)) [:style :color])
+                                 {:sid sid :id id :path [:style :color] :frame frame :value tone})))
+                    placements)]
+    (when (seq edits)
+      (rf/dispatch [::project/set-channels edits]))))
+
 (defn- swatch [pid i {:keys [name hex]} tone placements]
   (let [picker-id (str "palette-picker-" pid "-" i)]
-    [:div {:key i :class "palette-slot"}
+    [:div.slot {:key i}
-     [:button {:class (str "swatch" (when (= i tone) " on"))
+     [:button {:class (str "cell" (when (= i tone) " on"))
                :style {:background hex}
-               :title (str i (when name (str " · " (clojure.core/name name)))
+               :title (str "slot " i (when name (str " · " (clojure.core/name name)))
-                           " · " hex " · double-click to edit")
+                           " · " hex " — double-click to edit")
-               :on-click #(do (rf/dispatch [::ui/set-tone i])
+               :on-click #(pick! i placements)
-                              (let [edits (into [] (keep (fn [{:keys [sid id node frame]}]
-                                                   (when (contains? (get node/valid-paths (:kind node))
-                                                                    [:style :color])
-                                                     {:sid sid :id id :path [:style :color]
-                                                      :frame frame :value i})))
-                                                placements)]
-                                (when (seq edits)
-                                  (rf/dispatch [::project/set-channels edits]))))
                :on-double-click (fn [e]
                                   (.preventDefault e)
                                   (some-> (js/document.getElementById picker-id) (.click)))}]
@@ -43,46 +60,42 @@
               :aria-label (str "edit palette slot " i)
               :on-change #(rf/dispatch [::project/palette-color pid i (.. % -target -value)])}]]))
 
-(defn bar []
+(defn grid
-  (let [tone  @(rf/subscribe [::sub/tone])
+  "The colour chip and the slots, for the tool strip."
-        clip  @(rf/subscribe [::render/clip])
+  []
-        chosen @(rf/subscribe [::chosen])
+  (let [[_ pid palette] (shown)
-        pid   (if (contains? (:palettes clip) chosen) chosen (pal/default-palette-id clip))
+        tone       @(rf/subscribe [::sub/tone])
-        palette (get (pal/palettes clip) pid)
         placements @(rf/subscribe [::sub/selected-placements])
-        selections @(rf/subscribe [::sub/selections])
+        hex        (when (number? tone) (:hex (get (:slots palette) tone)))]
-        tool  @(rf/subscribe [::sub/tool])
+    [:div.palette
-        draft @(rf/subscribe [::sub/draft])]
+     [:div {:class (str "chip" (when (= :clear tone) " clear"))
-    [:div.palette-bar
+            :style (when hex {:background hex})
+            :title (if (= :clear tone)
+                     "clear: what is drawn knocks out what is under it in its symbol"
+                     (str "slot " tone " · " hex))}
+      [:span (if (= :clear tone) "×" tone)]]
+     [:div.cells
+      (doall (map-indexed #(swatch pid %1 %2 tone placements) (:slots palette)))
+      [:div.slot
+       [:button {:class (str "cell clear" (when (= :clear tone) " on"))
+                 :title "clear — draws a knockout: a hole in its symbol"
+                 :on-click #(pick! :clear placements)}]]]]))
+
+(defn assets
+  "Which palette asset the grid shows, and a new or duplicated one, for the
+  options bar."
+  []
+  (let [[clip pid palette] (shown)]
+    [:div.palette-assets
      [:select {:value (str pid)
                :title "palette asset"
                :on-change (fn [e]
-                            (let [v (.. e -target -value)
+                            (let [v  (.. e -target -value)
                                   id (first (filter #(= v (str %)) (keys (pal/palettes clip))))]
                               (rf/dispatch [::ui/set-tone 0])
-                              (rf/dispatch [:arthur.ui.palette/select id])))}
+                              (rf/dispatch [::select id])))}
       (for [[id p] (sort-by (comp str :name val) (pal/palettes clip))]
         ^{:key (str id)} [:option {:value (str id)} (:name p)])]
      [:button {:title "new 16-slot palette" :on-click #(rf/dispatch [::project/new-palette])} "+"]
      [:button {:title (str "duplicate " (:name palette) " — a copy you can retone")
-               :on-click #(rf/dispatch [::project/duplicate-palette pid])} "⧉"]
+               :on-click #(rf/dispatch [::project/duplicate-palette pid])} "⧉"]]))
-     [:div.swatches (doall (map-indexed #(swatch pid %1 %2 tone placements) (:slots palette)))]
-     [:span.dim (str tone)]
-     (when (> (count selections) 1)
-       [:span.dim (str (count selections) " selected")])
-     [:span {:style {:flex 1}}]
-     (if (= :polygon tool)
-       [:<>
-        [:span.dim (str (quot (count draft) 2) " points")]
-        [:button {:disabled (< (count draft) 6)
-                  :on-click #(rf/dispatch [::ui/finish-polygon])} "finish"]
-        [:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "cancel"]]
-       [:button {:title "pen tool — click points on the stage"
-                 :on-click #(rf/dispatch [::ui/begin-polygon])} "pen"])
-     ;; The stage's zoom, at the right end of the bar above the stage: it is a
-     ;; property of the view and not of the document, so it sits in the view's
-     ;; own chrome rather than in the inspector.
-     [layout/zoomer :stage "the stage"]]))
-
-(rf/reg-event-db :arthur.ui.palette/select
- (fn [db [_ id]] (assoc-in db [:ui :palette] id)))

frontend/src/arthur/ui/player.cljs

@@ -20,12 +20,14 @@
   no global interceptors."
   (:require [arthur.clock :as clock]
             [arthur.domain.clip :as clip]
+            [arthur.domain.outline :as outline]
             [arthur.domain.palette :as pal]
             [arthur.domain.pick :as pick]
             [arthur.domain.raster :as raster]
             [arthur.events.playback :as pb]
             [arthur.subs.playback :as sub]
             [arthur.subs.render :as render]
+            [arthur.subs.ui :as ui-sub]
             [arthur.ui.canvas :as canvas]
             [arthur.ui.underlay :as underlay]
             [re-frame.core :as rf]
@@ -103,9 +105,19 @@
   (some-> @tracker ratom/dispose!)
   (reset! tracker
           (ratom/run!
-           (let [{was :resolver was-u :underlay} @snapshot
+           (let [{was :resolver was-u :underlay :as before} @snapshot
                  now @(rf/subscribe [::render/shown])
-                 u   @(rf/subscribe [::render/underlay])]
+                 u   @(rf/subscribe [::render/underlay])
+                 ;; The pen's draft is drawn INTO the picture, filled, so what
+                 ;; is on screen while placing points is the pixels a finished
+                 ;; shape will be.
+                 pen {:draft   @(rf/subscribe [::ui-sub/draft])
+                      :hover   @(rf/subscribe [::ui-sub/hover])
+                      :tone    @(rf/subscribe [::ui-sub/tone])
+                      :spacing @(rf/subscribe [::ui-sub/spacing])
+                      ;; Where a new shape would land, so what is being drawn
+                      ;; is drawn in that symbol's stacking context.
+                      :target  (:path @(rf/subscribe [::ui-sub/creation-target]))}]
              (reset! snapshot
                      {:resolver now
                       :palette  @(rf/subscribe [::render/palette])
@@ -116,7 +128,8 @@
                       :height   @(rf/subscribe [::sub/height])
                       :underlay u
                       :frame    @(rf/subscribe [::sub/frame])
-                      :playing? @(rf/subscribe [::sub/playing?])})
+                      :playing? @(rf/subscribe [::sub/playing?])
+                      :pen      pen})
              ;; A new resolver means a new scene or a new palette, and neither
              ;; moves the playhead — so nothing else would ask for a redraw.
              ;;
@@ -129,9 +142,22 @@
              ;; Comparing the whole map is as cheap as picking fields out of it:
              ;; the document and the store it carries are the same OBJECTS unless
              ;; the resolver changed too, and that is tested first.
-             (when-not (and (identical? was now) (= was-u u))
+             (when-not (and (identical? was now) (= was-u u) (= pen (:pen before)))
                (repaint!))))))
 
+;; The brush or eraser stroke being painted: its mask, mutated in place as the
+;; pointer moves, which is why it is an atom the stage pokes rather than state
+;; anything renders from. `{:mask :version :slot :knock :target}`, `:mask` being an
+;; `outline/mask`.
+(defonce ^:private stroke (atom nil))
+(defonce ^:private trace-cache (atom nil))
+
+(defn stroke!
+  "Show stroke `s` in the picture until it is replaced or nil, and redraw."
+  [s]
+  (reset! stroke s)
+  (repaint!))
+
 (defn set-canvas! [el]
   (swap! state assoc :canvas el)
   ;; The :ref fires AFTER the loop has started, so the first tick or two run
@@ -154,9 +180,55 @@
   [point]
   (pick/hit (:ops @state) point))
 
+(defn hit-op
+  "The topmost op that shows at `point`, as `at` picks it: what the eraser
+  starts on."
+  [point]
+  (pick/hit-op (:ops @state) point))
+
 (defn in-rect [rect depth]
   (pick/in-rect (:ops @state) rect depth))
 
+(defn- index-of-slot [palette active slot]
+  (if (and (:palettes palette) (:offsets palette))
+    (pal/render-index palette active slot)
+    slot))
+
+(defn- traced
+  "Stroke `s` as the polygons letting go would make of it: traced and
+  simplified by the same function the saved shapes are, so the preview IS them.
+  Once per version of the mask and spacing, not once per paint."
+  [{:keys [mask version]} spacing]
+  (let [key [mask version spacing]]
+    (if (= key (:key @trace-cache))
+      (:polys @trace-cache)
+      (:polys (reset! trace-cache
+                      {:key key
+                       :polys (mapv #(outline/polygon % spacing) (outline/pieces mask))})))))
+
+(defn- with-previews
+  "What is being drawn and is not in the document yet, added to `ops` in the
+  stacking context of the symbol it will land in: the pen's draft as far as the
+  pointer, and a stroke as the polygons it will be. A knockout goes INTO that
+  symbol's layer, so it clears what the saved one will and nothing else."
+  [ops palette active]
+  (let [{:keys [draft hover tone spacing target]} (:pen @snapshot)
+        target (or target [])
+        pts (cond-> (vec draft) (and (seq draft) hover) (into hover))
+        {:keys [slot knock] :as s} @stroke
+        poly (fn [ring op] (assoc op :kind :poly :pts (into-array ring) :n (quot (count ring) 2)))]
+    (cond-> ops
+      (and (<= 6 (count pts)) (number? tone))
+      (clip/atop target (poly pts {:color (index-of-slot palette active tone)}))
+
+      (and (:mask s) (nil? knock))
+      (as-> ops (reduce #(clip/atop %1 target (poly %2 {:color (index-of-slot palette active slot)}))
+                        ops (traced s spacing)))
+
+      (and (:mask s) knock)
+      (as-> ops (reduce #(clip/in-layer %1 (or (:target s) target) (poly %2 {:color 0 :knock knock}))
+                        ops (traced s spacing))))))
+
 (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
@@ -179,7 +251,7 @@
         (swap! state assoc :ops ops)
         (-> ras
             (raster/clear! bg)
-            (raster/draw-ops! ops))
+            (raster/draw-ops! (with-previews ops palette active)))
         (js/performance.mark "arthur/blit:start")
         (canvas/blit! canvas ras (pal/effective-ramp palette active))
         (underlay/paint! (assoc underlay :width width :playing? playing?)

frontend/src/arthur/ui/shell.cljs

@@ -14,12 +14,12 @@
             [arthur.subs.render :as render]
             [arthur.ui.layout :as layout]
             [arthur.ui.location :as location]
-            [arthur.ui.palette :as palette]
+                        [arthur.ui.params :as params]
-            [arthur.ui.params :as params]
             [arthur.ui.pool :as pool]
             [arthur.ui.stage :as stage]
             [arthur.ui.tabs :as tabs]
             [arthur.ui.timeline :as timeline]
+            [arthur.ui.tools :as tools]
             [arthur.ui.topbar :as topbar]
             [re-frame.core :as rf]
             [reagent.core :as r]))
@@ -74,8 +74,10 @@
      (when-not (gone? :pool) [layout/grip :pool pool :col 1])
      [:section.view
       [tabs/view]
-      [palette/bar]
+      [tools/options]
-      [stage/view]]
+      [:div.workspace
+       [tools/toolbox]
+       [stage/view]]]
      (when-not (gone? :params) [layout/grip :params params :col -1])
      (when-not (gone? :params) [params/view])
      ;; Above the timeline rather than inside it: the bar says where an edit would

frontend/src/arthur/ui/stage.cljs

@@ -14,6 +14,7 @@
             [arthur.domain.gesture :as gesture]
             [arthur.domain.nest :as nest]
             [arthur.domain.node :as node]
+            [arthur.domain.outline :as outline]
             [arthur.domain.paint :as paint]
             [arthur.domain.pick :as pick]
             [arthur.events.paint :as paint-events]
@@ -25,6 +26,7 @@
             [arthur.ui.drag :as drag]
             [arthur.ui.layout :as layout]
             [arthur.ui.player :as player]
+            [arthur.ui.tools :as tools]
             [arthur.ui.underlay :as underlay]
             [re-frame.core :as rf]
             [reagent.core :as r]))
@@ -344,10 +346,147 @@
                                :width (+ 2 (* 2.1 (count label))) :height 5}]
             [:text.creation-target-tag {:x 1 :y 3.8} label]])]))))
 
+;; ---------------------------------------------------------------------------
+;; the drawing tools
+
+;; Where the pointer is over the stage, in stage pixels: the brush's footprint
+;; and the pen's edge marker follow it. A ratom, read only by `cursor` and
+;; `points`, so a move re-renders those and not the overlay.
+(defonce ^:private pointer (r/atom nil))
+
+;; The brush or eraser stroke under the pointer, as `dragging` is for a vertex.
+(defonce ^:private painting (atom nil))
+
+(def ^:private close-by
+  "Stage pixels from the first point at which a click closes the polygon."
+  3)
+
+(defn- snapped
+  "`p` from the draft's last point, at the nearest 45° when ⇧ is held."
+  [draft [x y :as p] ^js event]
+  (if (and (.-shiftKey event) (<= 2 (count draft)))
+    (let [ax (nth draft (- (count draft) 2)) ay (peek draft)
+          a  (* (/ js/Math.PI 4) (js/Math.round (/ (js/Math.atan2 (- y ay) (- x ax)) (/ js/Math.PI 4))))
+          d  (js/Math.hypot (- x ax) (- y ay))]
+      [(js/Math.round (+ ax (* d (js/Math.cos a)))) (js/Math.round (+ ay (* d (js/Math.sin a))))])
+    p))
+
+(defn- closes? [draft [x y]]
+  (and (<= 6 (count draft))
+       (<= (js/Math.hypot (- x (first draft)) (- y (second draft))) close-by)))
+
+(defn- on-edge
+  "`[i t]`: the edge of ring `pts` that stage point `p` is on, from point `i`
+  a fraction `t` of the way to the next — or nil."
+  [pts [x y]]
+  (let [ps (pairs pts) n (count ps)]
+    (some (fn [i]
+            (let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))
+                  dx (- bx ax) dy (- by ay)
+                  l2 (+ (* dx dx) (* dy dy))
+                  t  (if (zero? l2) 0 (/ (+ (* (- x ax) dx) (* (- y ay) dy)) l2))]
+              (when (and (< 0.05 t 0.95)
+                         (<= (js/Math.hypot (- x (+ ax (* t dx))) (- y (+ ay (* t dy)))) 1.5))
+                [i t])))
+          (range n))))
+
+(defn- stroke-begin!
+  "Start painting with the brush, or erasing, at stage point `p`.
+
+  The eraser's target is the symbol holding what the stroke STARTS on, and it
+  clears that colour only — Photoshop's background eraser — or, with ⌥, every
+  colour. Starting on nothing with ⌥ erases in the open symbol."
+  [{:keys [open f] :as ctx} tool p size tone ^js event]
+  (let [eraser? (= :eraser tool)
+        op      (when eraser? (player/hit-op p))
+        path    (when op (let [n (:node op)] (if (vector? n) n [n])))
+        all?    (.-altKey event)
+        {document :clip st :store} (loaded ctx)
+        slot    (when path
+                  (when-let [{:keys [sid id frame]} (nest/placement document st open path f)]
+                    (channel/value-at (get-in document [:symbols sid :nodes id :channels [:style :color]])
+                                      frame st)))
+        m       (outline/stamp! (outline/mask (:w ctx) (:h ctx)) p p size)
+        s       (cond
+                  ;; The brush's target is the creation target, which the player
+                  ;; reads for itself: nil here.
+                  (not eraser?)
+                  {:mask m :slot tone :knock (when (= :clear tone) -1)}
+                  (or all? path)
+                  {:mask m :knock (if all? -1 (:color op)) :target (if path (pop path) [])
+                   :down (if path (pop path) []) :colour (if all? :clear [:clear slot])})]
+    (if s
+      (do (reset! painting (assoc s :last p :size size :version 0))
+          (player/stroke! (assoc s :version 0)))
+      (rf/dispatch [::ui/refuse "nothing to erase there — ⌥ erases every colour"]))))
+
+(defn- stroke-move! [p]
+  (when-let [{:keys [mask last size]} @painting]
+    (outline/stamp! mask last p size)
+    ;; The version says the mask changed under the same object, so the player
+    ;; traces it again — once a frame at most, however fast the pointer moves.
+    (player/stroke! (swap! painting #(-> % (assoc :last p) (update :version inc))))))
+
+(defn- stroke-end! []
+  (when-let [{:keys [mask down colour]} @painting]
+    (reset! painting nil)
+    ;; Synchronously, so the shapes are in the document before the preview of
+    ;; them goes: otherwise the stroke blinks out for a frame in between.
+    (rf/dispatch-sync [::ui/stroke {:pieces (outline/pieces mask) :down down :colour colour}])
+    (player/stroke! nil)))
+
+(defn- cursor
+  "The brush's footprint under the pointer, the size it paints."
+  [tool]
+  (let [size @(rf/subscribe [::sub/brush])]
+    (when-let [[x y] @pointer]
+      [:circle {:class (str "footprint " (name tool)) :cx x :cy y :r (/ size 2)}])))
+
+(defn- points
+  "The pen on the selected shape: its points to drag, ⌥-click to delete, and a
+  marker where a click on an edge would add one."
+  [ctx draft]
+  (let [[sid id geom active editable? frame matrix] (editing)
+        pts (when geom (through matrix (channel/value-at geom frame (:store (loaded ctx)))))
+        edge (when (and editable? (empty? draft) (not (channel/nothing? pts)) @pointer)
+               (on-edge pts @pointer))]
+    (when (and pts (not (channel/nothing? pts)))
+      [:g.points
+       [:polygon.outline {:points (points-text pts)}]
+       (when-let [[i t] edge]
+         (let [[ax ay] (nth (pairs pts) i) [bx by] (nth (pairs pts) (mod (inc i) (quot (count pts) 2)))]
+           [:circle.insert {:cx (+ ax (* t (- bx ax))) :cy (+ ay (* t (- by ay))) :r 1.6}]))
+       (when-let [inv (when editable? (node/invert matrix))]
+         (doall
+          (for [[i [x y]] (map-indexed vector (pairs pts))]
+            ^{:key i}
+            [:circle.vertex {:cx x :cy y :r 1.8
+                             :on-pointer-down
+                             (fn [^js event]
+                               (.stopPropagation event)
+                               (.preventDefault event)
+                               (if (.-altKey event)
+                                 (rf/dispatch [::ui/delete-vertex sid id i])
+                                 (do (.setPointerCapture (.-currentTarget event) (.-pointerId event))
+                                     (reset! dragging [sid id active i inv]))))}])))])))
+
+(defn- draft-lines
+  "The pen's draft as hairlines — the fill is in the picture — with the segment
+  to the pointer, and a ring on the first point when a click there closes it."
+  [draft hover]
+  (when (seq draft)
+    (let [[fx fy] draft]
+      [:g.draft
+       [:polyline {:points (points-text (cond-> draft hover (into hover)))}]
+       [:circle {:class (str "first" (when (and hover (closes? draft hover)) " closing"))
+                 :cx fx :cy fy :r 1.8}]])))
+
 (defn- overlay [w h zoom]
   (let [tool  @(rf/subscribe [::sub/tool])
         draft @(rf/subscribe [::sub/draft])
-        drawing? (= :polygon tool)
+        hover @(rf/subscribe [::sub/hover])
+        tone  @(rf/subscribe [::sub/tone])
+        size  @(rf/subscribe [::sub/brush])
         [_ _ _ selected] @(rf/subscribe [::sub/selection])
         selections @(rf/subscribe [::sub/selections])
         placements @(rf/subscribe [::sub/selected-placements])
@@ -359,68 +498,88 @@
              ;; edit's coordinate is the document's.
              :open @(rf/subscribe [::render/open]) :f @(rf/subscribe [::render/open-frame])
              :w w :h h}
-        points? @(rf/subscribe [::sub/points])
+        pen? (= :pen tool)
-        [sid id geom active editable? frame matrix] (when points? (editing))
+        ;; The shape the pen is on, read while rendering: a click handler is
-        pts (when geom (through matrix (channel/value-at geom frame
+        ;; not a reactive context to subscribe from.
-                                                          (:store (store/entry clip-id)))))
+        [esid eid egeom _ editable? eframe matrix] (when pen? (editing))
+        paints? (#{:brush :eraser} tool)
         mark @marquee]
-    [:svg {:class (str "paint-overlay" (when drawing? " drawing"))
+    [:svg {:class (str "paint-overlay tool-" (name tool)
+                       (when (and pen? hover (closes? draft hover)) " closing"))
            :width (* zoom w) :height (* zoom h)
            :view-box (str "0 0 " w " " h)
            :tab-index -1
-           :on-pointer-down (fn [^js event]
+           :on-pointer-down
-                              (if drawing?
+           (fn [^js event]
-                                (let [[x y] (stage-point event w h)]
+             (let [svg (.-currentTarget event)
-                                  (rf/dispatch [::ui/add-draft-point x y]))
+                   p   (xy svg event w h)]
-                                (let [svg (.-currentTarget event)
+               (.focus svg)
-                                      p   (xy svg event w h)
+               (case tool
-                                      path (pick/choose selected (player/at p)
+                 :pen
-                                                        (or (.-metaKey event) (.-ctrlKey event)))]
+                 (let [q (snapped draft (stage-point event w h) event)
-                                  (.focus svg)
+                       pts  (when (and egeom editable? (empty? draft))
-                                  (cond
+                              (through matrix (channel/value-at egeom eframe (:store (loaded ctx)))))
-                                    (and (.-shiftKey event) path)
+                       edge (when (and pts (not (channel/nothing? pts))) (on-edge pts p))]
-                                    (when-let [address (address-for ctx path)]
+                   (cond
-                                      (rf/dispatch [::ui/toggle-selection address]))
+                     (closes? draft q) (rf/dispatch [::ui/finish-polygon])
+                     edge (rf/dispatch [::ui/insert-vertex esid eid (first edge) (second edge)])
+                     :else (rf/dispatch [::ui/add-draft-point (first q) (second q)])))
 
-                                    path
+                 (:brush :eraser)
-                                    (when-not (contains? selected-paths path) (select! ctx path))
+                 (do (.setPointerCapture svg (.-pointerId event))
+                     (stroke-begin! ctx tool p size tone event))
 
-                                    :else
+                 (let [path (pick/choose selected (player/at p)
-                                    (do (.setPointerCapture svg (.-pointerId event))
+                                         (or (.-metaKey event) (.-ctrlKey event)))]
-                                        (reset! marquee {:p0 p :p p :more? (.-shiftKey event)})))
+                   (cond
-                                  (when (and path (not (.-shiftKey event)))
+                     (and (.-shiftKey event) path)
-                                    (.setPointerCapture svg (.-pointerId event))
+                     (when-let [address (address-for ctx path)]
-                                    (if (and (> (count placements) 1) (contains? selected-paths path))
+                       (rf/dispatch [::ui/toggle-selection address]))
-                                      (begin-many! ctx :move placements p)
+
-                                      (begin! ctx :move path p))))))
+                     path
+                     (when-not (contains? selected-paths path) (select! ctx path))
+
+                     :else
+                     (do (.setPointerCapture svg (.-pointerId event))
+                         (reset! marquee {:p0 p :p p :more? (.-shiftKey event)})))
+                   (when (and path (not (.-shiftKey event)))
+                     (.setPointerCapture svg (.-pointerId event))
+                     (if (and (> (count placements) 1) (contains? selected-paths path))
+                       (begin-many! ctx :move placements p)
+                       (begin! ctx :move path p)))))))
            :on-double-click (fn [^js event]
-                              (when-not drawing?
+                              (when (= :select tool)
                                 (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])))))
+                                    ;; Into the shape: the pen, on its points.
+                                    (= hit selected) (rf/dispatch [::ui/set-tool :pen])))))
            :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?))
+                          (when (and (= "Escape" (.-key event)) selected (= :select tool))
-                            (if points?
+                            (select! ctx (pop selected))))
-                              (rf/dispatch [::ui/points false])
+           :on-pointer-leave (fn [_] (reset! pointer nil))
-                              (select! ctx (pop selected)))))
+           :on-pointer-move
-           :on-pointer-move (fn [event]
+           (fn [^js event]
-                              ;; Back through the inverse of what the handle was
+             (let [p (xy (.-currentTarget event) event w h)]
-                              ;; drawn through, into the shape's own coordinates.
+               (reset! pointer p)
-                              (if-let [[sid node key-frame vertex inv] @dragging]
+               (cond
-                                (rf/dispatch [::paint-events/set-vertex
+                 ;; Back through the inverse of what the handle was drawn
-                                              sid node key-frame vertex
+                 ;; through, into the shape's own coordinates.
-                                              (through inv (stage-point event w h))])
+                 @dragging (let [[sid node key-frame vertex inv] @dragging]
-                                (let [p (xy (.-currentTarget event) event w h)]
+                             (rf/dispatch [::paint-events/set-vertex sid node key-frame vertex
-                                  (if @marquee
+                                           (through inv (stage-point event w h))]))
-                                    (swap! marquee assoc :p p)
+                 @painting (stroke-move! p)
-                                    (when @gesture (drag! p event))))))
+                 (and pen? (seq draft)) (let [q (snapped draft (stage-point event w h) event)]
+                                          (when (not= q hover) (rf/dispatch [::ui/hover q])))
+                 @marquee (swap! marquee assoc :p p)
+                 @gesture (drag! p event))))
            :on-pointer-up     (fn [_]
                                 (reset! dragging nil)
+                                (stroke-end!)
                                 (if-let [{:keys [p0 p more?]} @marquee]
                                   (let [depth (or (some-> selected count) 1)
                                         paths (player/in-rect [(first p0) (second p0)
@@ -431,11 +590,10 @@
                                     (rf/dispatch [::ui/select-many (into old addresses)]))
                                   (let-go! true)))
            :on-pointer-cancel (fn [_]
-                                (reset! dragging nil) (reset! marquee nil) (let-go! false))}
+                                (reset! dragging nil) (reset! marquee nil)
+                                (reset! painting nil) (player/stroke! nil)
+                                (let-go! false))}
      [ghost]
-     (when (seq draft)
-       [:polyline {:points (points-text draft) :fill "none"
-                   :stroke "#d0ba86" :stroke-width 1}])
      (when mark
        (let [[[x0 y0] [x1 y1]] [(:p0 mark) (:p mark)]]
          [:rect.marquee {:x (min x0 x1) :y (min y0 y1)
@@ -444,26 +602,12 @@
      ;; 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? [creation-box])
+     [creation-box]
-     (when-not (or drawing? points?)
+     (when (= :select tool)
        (if (> (count placements) 1) [group-handles ctx placements] [handles ctx]))
-     (when (and id pts (not drawing?) (not (channel/nothing? pts)))
+     (when pen? [points ctx draft])
-       [:g
+     (when pen? [draft-lines draft hover])
-        [:polygon {:points (points-text pts) :fill "none"
+     (when paints? [cursor tool])]))
-                   :stroke "#e6ca8b" :stroke-width 1}]
-        (when-let [inv (when editable? (node/invert matrix))]
-          (doall
-           (for [[i [x y]] (map-indexed vector (pairs pts))]
-             ^{:key i}
-             [:circle.vertex {:cx x :cy y :r 2.6 :fill "#fff1be"
-                              :stroke "#161820" :stroke-width 0.7
-                              :on-pointer-down
-                              (fn [event]
-                                (.stopPropagation event)
-                                (.preventDefault event)
-                                (.setPointerCapture (.-currentTarget event)
-                                                    (.-pointerId event))
-                                (reset! dragging [sid id active i inv]))}])))])]))
 
 (defn view []
   ;; Reactive on the clip's dimensions, so selecting a clip of another size
@@ -505,4 +649,5 @@
                          :width (* zoom w) :height (* zoom h)}]
       [overlay w h zoom]]
      (when destination-name
-       [:div.stage-target "creating in " [:strong destination-name]])]))
+       [:div.stage-target "creating in " [:strong destination-name]])
+     [tools/adjust-last]]))

frontend/src/arthur/ui/tools.cljs

@@ -0,0 +1,119 @@
+(ns arthur.ui.tools
+  "The tools: a strip down the left of the stage, an options bar across the top
+  of it, and their keys.
+
+  PHOTOSHOP'S ARRANGEMENT, which Illustrator and Flash share: one tool at a
+  time, picked from a vertical strip or by its letter, and a bar above the
+  canvas holding that tool's options — the brush's size, the pen's point count.
+  The palette sits in the strip under the tools. See `events/ui` for what each
+  tool does to the selection."
+  (:require [arthur.events.ui :as ui]
+            [arthur.subs.ui :as sub]
+            [arthur.ui.layout :as layout]
+            [arthur.ui.palette :as palette]
+            [re-frame.core :as rf]))
+
+(def ^:private kit
+  [{:tool :select :key "v" :name "Select"
+    :tip "click to select, drag to move · double-click a shape to edit its points"
+    :icon [:path {:d "M4 2 L4 14 L7 11 L9.5 16 L11.5 15 L9 10 L13 10 Z"}]}
+   {:tool :pen :key "p" :name "Pen"
+    :tip "click to place points · click the first to close · on a selected shape, click an edge to add a point and ⌥-click a point to delete it"
+    :icon [:<> [:path {:d "M9 1 L14 8 L11.5 13 L6.5 13 L4 8 Z"}]
+           [:path.cut {:d "M9 2 V8"}]
+           [:rect {:x 6.5 :y 14 :width 5 :height 2}]]}
+   {:tool :brush :key "b" :name "Brush"
+    :tip "paint, and each piece becomes a polygon when you let go"
+    :icon [:<> [:path {:d "M15 1.5 L16.5 3 L9 10.5 L7.5 9 Z"}]
+           [:path {:d "M6.5 10 C4 10 3 11.5 3 13.5 C3 15 1.5 16 1.5 16 C5 16 8 15 8 11.5 Z"}]]}
+   {:tool :eraser :key "e" :name "Eraser"
+    :tip "erases the colour you start on, in its symbol · ⌥ erases every colour"
+    :icon [:<> [:path {:d "M10 2.5 L16 8.5 L10 14.5 L5.5 14.5 L2 11 Z"}]
+           [:path.cut {:d "M6 6.5 L12 12.5"}]]}])
+
+(defn toolbox []
+  (let [tool @(rf/subscribe [::sub/tool])]
+    [:aside.toolbox
+     [:div.tools
+      (doall
+       (for [{t :tool :keys [key name tip icon]} kit]
+         ^{:key t}
+         [:button {:class (str "tool" (when (= t tool) " on"))
+                   :title (str name " (" (.toUpperCase key) ") — " tip)
+                   :on-click #(rf/dispatch [::ui/set-tool t])}
+          [:svg {:view-box "0 0 18 18" :width 18 :height 18} icon]]))]
+     [palette/grid]]))
+
+(defn- size-control []
+  (let [size @(rf/subscribe [::sub/brush])]
+    [:label.option {:title "[ and ]"} "size"
+     [:input {:type "range" :min 1 :max 64 :value size
+              :on-change #(rf/dispatch [::ui/brush-size (js/parseInt (.. % -target -value))])}]
+     [:span.value (str size "px")]]))
+
+(defn- spacing-control
+  "A point every so many pixels of outline: the brush's detail, by length."
+  [spacing event]
+  [:label.option {:title "fewer pixels between points is more detail"} "a point every"
+   [:input {:type "range" :min 1 :max 40 :value spacing
+            :on-change #(rf/dispatch [event (js/parseInt (.. % -target -value))])}]
+   [:span.value (str spacing "px")]])
+
+(defn options []
+  (let [tool  @(rf/subscribe [::sub/tool])
+        draft @(rf/subscribe [::sub/draft])
+        selections @(rf/subscribe [::sub/selections])
+        {:keys [name tip]} (some #(when (= tool (:tool %)) %) kit)]
+    [:div.options-bar
+     [:strong.tool-name name]
+     (case tool
+       :pen (if (seq draft)
+              [:<>
+               [:span.dim (str (quot (count draft) 2) " points")]
+               [:button {:disabled (< (count draft) 6) :title "Enter"
+                         :on-click #(rf/dispatch [::ui/finish-polygon])} "close"]
+               [:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "discard"]]
+              [:span.dim.hint tip])
+       (:brush :eraser) [:<> [size-control]
+                         [spacing-control @(rf/subscribe [::sub/spacing]) ::ui/spacing]
+                         [:span.dim.hint tip]]
+       (if (< 1 (count selections))
+         [:span.dim (str (count selections) " selected")]
+         [:span.dim.hint tip]))
+     [:span.spacer]
+     [palette/assets]
+     ;; The stage's zoom: a property of the view and not of the document, so it
+     ;; sits in the view's own chrome rather than in the inspector.
+     [layout/zoomer :stage "the stage"]]))
+
+(defn adjust-last
+  "Blender's Adjust Last Operation, for a brush or eraser stroke: its spacing,
+  changeable until something else is done."
+  []
+  (when-let [{:keys [kind ids spacing]} @(rf/subscribe [::sub/last])]
+    [:div.adjust-last
+     [:strong (if (= :eraser kind) "Erase" "Brush stroke")]
+     (when (< 1 (count ids)) [:span.dim (str (count ids) " pieces")])
+     [spacing-control spacing ::ui/adjust-last]]))
+
+(defn- typing?
+  "Is a key going into a field? A slider or a checkbox has focus without
+  taking letters, and a tool's key still picks the tool there, as in Photoshop."
+  [^js target]
+  (or (#{"TEXTAREA" "SELECT"} (.-tagName target))
+      (and (= "INPUT" (.-tagName target))
+           (not (#{"range" "checkbox" "radio" "button" "color"} (.-type target))))
+      (.-isContentEditable target)))
+
+(defn install-keys!
+  "V, P, B and E pick a tool. Enter closes the pen's polygon, or takes the pen
+  to the selected shape's points; Esc closes it too, and then leaves the pen.
+  [ and ] size the brush. Delete and undo are `events/history`'s."
+  []
+  (.addEventListener
+   js/window "keydown"
+   (fn [^js e]
+     (when-not (or (typing? (.-target e)) (.-metaKey e) (.-ctrlKey e) (.-altKey e))
+       (when (contains? ui/tool-keys (.toLowerCase (.-key e)))
+         (.preventDefault e)
+         (rf/dispatch [::ui/tool-key (.toLowerCase (.-key e))]))))))

frontend/test/arthur/domain/instance_test.cljs

@@ -7,6 +7,8 @@
             [arthur.domain.nest :as nest]
             [arthur.domain.node :as node]
             [arthur.domain.paint :as paint]
+            [arthur.domain.pick :as pick]
+            [arthur.domain.raster :as raster]
             [arthur.domain.pose :as pose]
             [arthur.domain.palette :as pal]
             [arthur.domain.symbol :as symbol]))
@@ -480,3 +482,43 @@
     (is (= [128 128 128]
            (nth (pal/effective-ramp context (clip/active-palette resolve))
                 (pal/render-index context day 1))))))
+(deftest a-knockout-makes-a-hole-in-its-own-symbol-only
+  (let [sq (fn [x0 y0 x1 y1] [x0 y0 x1 y0 x1 y1 x0 y1])
+        document
+        (-> (clip/blank)
+            (assoc-in [:symbols :lens] {:id :lens :frames 4 :nodes {}})
+            (paint/new-shape :main :under 0 (sq 0 0 40 20) 4)
+            (paint/new-shape :lens :frame 0 (sq 0 0 40 20) 8)
+            (paint/new-shape :lens :glass 0 (sq 10 5 20 15) :clear)
+            (assoc-in [:symbols :main :nodes :glasses]
+                      {:id :glasses :kind :instance :source {:symbol :lens} :z "zz" :span [0 4]}))
+        ops (vec ((clip/resolver document :main nil (pal/compile document) nil) 0))
+        ras (raster/draw-ops! (raster/clear! (raster/make 320 200) 0) ops)
+        at  (fn [x y] (aget (:buf ras) (+ x (* y 320))))
+        colour (fn [path] (:color (first (filter #(= path (:node %)) ops))))]
+    (is (= [:begin :poly :poly :end]
+           (mapv :kind (filter #(and (vector? (:node %)) (= :glasses (first (:node %)))) ops))))
+    (is (= (colour :under) (at 15 10)) "the glass shows what is under the glasses")
+    (is (= (colour [:glasses :frame]) (at 5 10)) "and the frame is still there round it")
+    (is (not= (at 15 10) (at 5 10)))
+    (is (= [:under] (pick/hit ops [15 10])) "a click in the glass is a click on what shows")
+    (is (= [:glasses :frame] (pick/hit ops [5 10])))))
+
+(deftest an-op-goes-into-the-layer-of-the-symbol-it-is-for
+  (let [a {:kind :poly :node :a} b {:kind :poly :node [:g :b]} c {:kind :poly :node [:g :c]}
+        k {:kind :mask :knock -1}]
+    (is (= [a {:kind :begin :node [:g]} b c k {:kind :end :node [:g]}]
+           (clip/in-layer [a b c] [:g] k)) "a layer is made round what it drew")
+    (is (= [a {:kind :begin :node [:g]} b k {:kind :end :node [:g]} c]
+           (clip/in-layer [a {:kind :begin :node [:g]} b {:kind :end :node [:g]} c] [:g] k))
+        "an existing one is used")
+    (is (= [{:kind :begin :node []} a b k {:kind :end :node []}]
+           (clip/in-layer [a b] [] k)) "the open symbol is every op")
+    (is (= [a] (clip/in-layer [a] [:nothing] k)))))
+
+(deftest a-preview-goes-on-top-of-its-own-symbol-only
+  (let [a {:kind :poly :node :a} b {:kind :poly :node [:g :b]} c {:kind :poly :node :c}
+        p {:kind :poly :preview true}]
+    (is (= [a b p c] (clip/atop [a b c] [:g] p)) "under what is above the symbol")
+    (is (= [a b c p] (clip/atop [a b c] [] p)) "the open symbol is on top of everything")
+    (is (= [a b c p] (clip/atop [a b c] [:empty] p)))))

frontend/test/arthur/domain/outline_test.cljs

@@ -0,0 +1,62 @@
+(ns arthur.domain.outline-test
+  (:require [cljs.test :refer [deftest is]]
+            [arthur.domain.outline :as outline]
+            [arthur.domain.raster :as r]))
+
+(defn- covered [{:keys [buf]}] (count (filter #(= 1 %) (array-seq buf))))
+
+(deftest a-traced-ring-fills-back-to-exactly-the-mask
+  (let [m (outline/stamp! (outline/mask 40 30) [8 8] [30 20] 6)
+        [ring & more] (outline/rings m)
+        back (r/fill-poly-buf! (r/make 40 30) ring (quot (count ring) 2) 1)]
+    (is (empty? more) "one stroke is one piece")
+    (is (= (vec (array-seq (:buf m))) (vec (array-seq (:buf back)))))))
+
+(deftest a-single-pixel-is-a-square
+  (let [m (outline/mask 5 5)]
+    (aset (:buf m) 12 1)
+    (is (= [[2 2 3 2 3 3 2 3]] (outline/rings m 0)))))
+
+(deftest pieces-are-traced-apart-biggest-first
+  (let [m (-> (outline/mask 40 20)
+              (outline/stamp! [5 10] [5 10] 4)
+              (outline/stamp! [20 10] [34 10] 6))]
+    (is (= 2 (count (outline/rings m))))
+    (is (< 8 (covered m)))
+    (is (< 15 (apply min (take-nth 2 (first (outline/rings m))))) "the long one first")))
+
+(deftest simplify-keeps-exactly-the-count-asked-for
+  (let [ring (first (outline/rings (outline/stamp! (outline/mask 60 60) [30 30] [30 30] 40)))]
+    (is (= 24 (count (outline/simplify ring 12))))
+    (is (= 6 (count (outline/simplify ring 1))) "never fewer than three points")
+    (is (= ring (outline/simplify ring 10000)))))
+
+(deftest a-loop-keeps-its-hole-in-one-ring
+  ;; A ring of brush round a gap: one piece, one hole, and the one polygon it
+  ;; makes fills back to the ring and leaves the gap empty.
+  (let [m (reduce (fn [m a]
+                    (let [p #(vector (+ 30 (* 15 (js/Math.cos %))) (+ 30 (* 15 (js/Math.sin %))))]
+                      (outline/stamp! m (p a) (p (+ a 0.3)) 5)))
+                  (outline/mask 60 60) (range 0 6.6 0.3))
+        [piece & more] (outline/pieces m)
+        fill (fn [ring] (:buf (r/fill-poly-buf! (r/make 60 60) ring (quot (count ring) 2) 1)))
+        middle (+ 30 (* 30 60))]
+    (is (empty? more))
+    (is (= 1 (count (:holes piece))))
+    (is (= (vec (array-seq (:buf m))) (vec (array-seq (fill (outline/polygon piece 0.01)))))
+        "unsimplified, the bridged ring is the stroke exactly")
+    (is (zero? (aget (fill (outline/polygon piece 0.01)) middle)) "the middle is a hole")
+    (is (zero? (aget (fill (outline/polygon piece 8)) middle)) "and simplified, still a hole")))
+
+(deftest points-go-by-length
+  (let [dab  (first (outline/pieces (outline/stamp! (outline/mask 80 40) [10 20] [10 20] 8)))
+        long (first (outline/pieces (outline/stamp! (outline/mask 80 40) [10 20] [70 20] 8)))]
+    (is (< (count (outline/polygon dab 6)) (count (outline/polygon long 6))))
+    (is (= 6 (count (outline/polygon dab 1000))) "never fewer than three")))
+
+(deftest a-gap-open-to-the-outside-is-not-a-hole
+  (let [m (-> (outline/mask 40 40)
+              (outline/stamp! [5 5] [30 5] 4)
+              (outline/stamp! [30 5] [30 30] 4)
+              (outline/stamp! [30 30] [5 30] 4))]
+    (is (= [] (:holes (first (outline/pieces m)))))))

frontend/test/arthur/domain/paint_test.cljs

@@ -33,3 +33,14 @@
     (is (some #(= :paint-test (:node %))
               (symbol/eval-frame (get-in c2 [:symbols :main]) 3 nil pal/index-of nil)))
     (is (= mixed-clip (leaf/clip :c1 (leaf/leaves :c1 mixed-clip))))))
+
+(deftest a-point-is-added-and-taken-away-on-every-key
+  (let [c0 (-> (paint/new-shape demo/clip :main :p 0 [0 0 10 0 10 10] :brow)
+               (paint/add-key :main :p 6)
+               (paint/set-vertex :main :p 6 1 [20 0]))
+        c1 (paint/insert-vertex c0 :main :p 0 0.5)
+        ks #(get-in % [:symbols :main :nodes :p :channels paint/geometry :keys])]
+    (is (= {0 [0 0 5 0 10 0 10 10] 6 [0 0 10 0 20 0 10 10]} (ks c1))
+        "half way along the same edge of each key")
+    (is (= (ks c0) (ks (paint/delete-vertex c1 :main :p 1))))
+    (is (= (ks c0) (ks (paint/delete-vertex c0 :main :p 0))) "a triangle keeps its three")))

frontend/test/arthur/domain/raster_test.cljs

@@ -219,3 +219,34 @@
       (let [dest (js/Uint8ClampedArray. (* 23 17 4))]
         (is (= (naive ras pal/rgb 1)
                (vec (array-seq (:data (r/->rgba ras pal/rgb 1 dest))))))))))
+
+(defn- sq [x0 y0 x1 y1] [x0 y0 x1 y0 x1 y1 x0 y1])
+
+(deftest a-knockout-clears-its-own-layer-and-nothing-under-it
+  (let [ras (-> (r/make 20 10) (r/clear! 0)
+                (r/draw-ops! [{:kind :poly :pts (sq 0 0 20 10) :n 4 :color 1}
+                              {:kind :begin}
+                              {:kind :poly :pts (sq 0 0 10 10) :n 4 :color 2}
+                              {:kind :poly :pts (sq 10 0 20 10) :n 4 :color 3}
+                              {:kind :poly :pts (sq 5 0 15 10) :n 4 :color 0 :knock -1}
+                              {:kind :end}]))]
+    (is (= 50 (count-index ras 2)) "0..5 of the left half is left")
+    (is (= 50 (count-index ras 3)) "15..20 of the right half is left")
+    (is (= 100 (count-index ras 1)) "the hole shows what was under the layer")))
+
+(deftest a-knockout-of-one-colour-leaves-the-others
+  (let [ras (-> (r/make 20 10) (r/clear! 0)
+                (r/draw-ops! [{:kind :begin}
+                              {:kind :poly :pts (sq 0 0 10 10) :n 4 :color 2}
+                              {:kind :poly :pts (sq 10 0 20 10) :n 4 :color 3}
+                              {:kind :poly :pts (sq 0 0 20 10) :n 4 :color 0 :knock 3}
+                              {:kind :end}]))]
+    (is (= 100 (count-index ras 2)))
+    (is (zero? (count-index ras 3)))))
+
+(deftest a-mask-op-paints-the-pixels-it-holds
+  (let [m (js/Uint8Array. 200)]
+    (aset m 3 1) (aset m 150 1)
+    (is (= 2 (count-index (-> (r/make 20 10) (r/clear! 0)
+                              (r/draw-ops! [{:kind :mask :mask m :color 4}]))
+                          4)))))

frontend/test/arthur/events/lane_test.cljs

@@ -335,7 +335,7 @@
             :playback {:frame 6}}
         after (ui/beginning-polygon db)
         saved (:clip (store/entry (:clip/current after)))]
-    (is (= :polygon (get-in after [:ui :tool])))
+    (is (= [] (get-in after [:ui :draft])) "a draft is begun")
     (is (= {} (get-in saved [:symbols :main :nodes])))
     (is (nil? (get-in saved [:symbols :main :display])))
     (is (nil? (get-in (store/entry (:clip/current after)) [:history :done])))))
@@ -353,7 +353,7 @@
     (is (not= :a cel-id) "the occupied cel is not reused")
     (is (= [1 2] (node/placed-span (get-in saved [:symbols sid :nodes cel-id]))))
     (is (= 1 (clip/frames saved (node/source (get-in saved [:symbols sid :nodes cel-id])))))
-    (is (= :polygon (get-in after [:ui :tool])))))
+    (is (= [] (get-in after [:ui :draft])))))
 
 (deftest sequence-commands-use-isolated-history-transactions
   (let [doc (fixture/document)
@@ -455,7 +455,7 @@
       (is (= :drawing-a sid) "the shape went into the drawing the selected clip places")
       (is (= [:a shape-id] path))
       (is (empty? (get-in after [:ui :expanded])))
-      (is (nil? (get-in after [:ui :tool]))))))
+      (is (empty? (get-in after [:ui :draft])) "the pen stays the tool, with nothing drafted"))))
 
 (deftest a-clip-made-for-a-drawing-is-selected-in-the-symbol-it-lives-in
   ;; The clip `beginning-polygon` materializes lives in the symbol the LANE

static/arthur/app.css

@@ -778,7 +778,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 .tab:hover .close, .tab.on .close { visibility: visible; }
 .tab .close:hover { background: var(--hair); color: var(--fg); }
 
-.palette-bar {
+.options-bar {
   display: flex;
   align-items: center;
   gap: 9px;
@@ -876,8 +876,6 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
 .paint-overlay { position: absolute; inset: 0; touch-action: none; }
 /* The footage traced over: a reference above the picture, never part of it. */
 .underlay { position: absolute; inset: 0; pointer-events: none; }
-.paint-overlay.drawing { cursor: crosshair; }
-.paint-overlay circle { cursor: grab; }
 
 /* Where a drag out of the pool would land. Dashed and unfilled, so it reads as
    "not there yet" over whatever is already drawn. */
@@ -1526,8 +1524,8 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
   .stage-area { padding: 5px; }
 
   /* Touch targets, in the strips that are all buttons. */
-  .pane-head, .palette-bar { gap: 7px; }
+  .pane-head, .options-bar { gap: 7px; }
-  .palette-bar button, .pane-head button, .top button { min-height: 24px; }
+  .options-bar button, .pane-head button, .top button { min-height: 24px; }
 
   /* A STRIP OF CONTROLS SCROLLS AS A STRIP. Flexbox's instinct when a row does
      not fit is to shrink every item and then push the last ones off the end —
@@ -1536,17 +1534,138 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
      So nothing shrinks, nothing wraps, and each strip scrolls. The `.spacer`
      and `.status` rules above still win on specificity, which is what keeps the
      right-hand groups right-hand while there IS room. */
-  .top > *, .pane-head > *, .palette-bar > * { flex-shrink: 0; }
+  .top > *, .pane-head > *, .options-bar > * { flex-shrink: 0; }
   .top button, .pane-head button { white-space: nowrap; }
-  .pane-head, .palette-bar { overflow-x: auto; }
+  .pane-head, .options-bar { overflow-x: auto; }
-
+  /* The hints go first: the tool's name and its controls are what is needed. */
-  /* The one compressible thing in the palette bar is the swatches, so they
+  .options-bar .hint { display: none; }
-     scroll inside their own share instead of taking it from the commands. The
+}
-     tone's NAME goes: the ringed swatch already says which one is active, and
+
-     it is the widest thing in the bar that nothing is lost by dropping. */
+/* --------------------------------------------------------------------------
-  .palette-bar .swatches { flex: 1 1 130px; min-width: 56px; overflow-x: auto; }
+   the tools: a strip down the left of the stage, an options bar above it.
-  /* A swatch is a 15px circle or it is not a swatch: the strip scrolls, the
+
-     dots do not get thinner. */
+   Photoshop's arrangement, which Illustrator and Flash share. The palette is a
-  .palette-bar .swatches > * { flex-shrink: 0; }
+   grid in the strip under the tools, as Deluxe Paint's and Animator Pro's were:
-  .palette-bar > .dim { display: none; }
+   a fixed table of slots, shown as one. */
+
+.options-bar {
+  gap: 8px;
+  min-height: 29px;
+  padding: 3px 8px;
+}
+.options-bar .tool-name { font-weight: 600; min-width: 46px; }
+.options-bar .hint { overflow: hidden; text-overflow: ellipsis; white-space: nowrap; min-width: 0; flex: 0 1 auto; }
+.options-bar .spacer { flex: 1; }
+.option { display: flex; align-items: center; gap: 6px; color: var(--dim); white-space: nowrap; }
+.option input[type="range"] { width: 110px; }
+.option .value { color: var(--fg); min-width: 30px; font-variant-numeric: tabular-nums; }
+.palette-assets { display: flex; align-items: center; gap: 3px; }
+
+.workspace { flex: 1; min-height: 0; display: flex; }
+.workspace > .stage-area { flex: 1; min-width: 0; position: relative; }
+
+.toolbox {
+  flex: 0 0 52px;
+  display: flex;
+  flex-direction: column;
+  align-items: center;
+  gap: 10px;
+  padding: 7px 0;
+  background: var(--chrome);
+  border-right: 1px solid var(--line);
+  overflow-y: auto;
+}
+
+.tools { display: grid; gap: 2px; }
+.tool {
+  width: 34px; height: 30px;
+  display: grid; place-items: center;
+  padding: 0;
+  border: 1px solid transparent;
+  border-radius: 4px;
+  background: none;
+  color: var(--fg);
+}
+.tool:hover { background: var(--sunk); border-color: var(--hair); }
+.tool.on { background: var(--sel-bg); border-color: var(--sel); color: var(--sel); }
+.tool svg { fill: currentColor; stroke: none; }
+.tool svg .cut { fill: none; stroke: var(--chrome); stroke-width: 1.2; }
+.tool.on svg .cut { stroke: var(--sel-bg); }
+
+.palette { display: grid; gap: 7px; justify-items: center; padding-top: 9px; border-top: 1px solid var(--hair); }
+
+/* The colour a new shape gets: Photoshop's foreground chip. */
+.palette .chip {
+  width: 36px; height: 36px;
+  display: grid; place-items: end start;
+  border: 1px solid var(--fg);
+  border-radius: 3px;
+  box-shadow: inset 0 0 0 2px var(--pane);
+}
+.palette .chip span {
+  margin: 0 0 2px 3px; padding: 0 3px;
+  border-radius: 2px;
+  background: rgba(255, 255, 255, .85);
+  color: var(--fg); font-size: 9px; line-height: 12px;
+}
+
+.palette .cells { display: grid; grid-template-columns: repeat(2, 17px); gap: 2px; }
+.palette .slot { display: contents; }
+.palette .cell {
+  width: 17px; height: 17px;
+  padding: 0;
+  border: 1px solid rgba(0, 0, 0, .35);
+  border-radius: 2px;
+  cursor: pointer;
+}
+.palette .cell:hover { border-color: var(--fg); transform: scale(1.12); }
+.palette .cell.on { border-color: var(--fg); box-shadow: 0 0 0 1px var(--pane), 0 0 0 2px var(--sel); position: relative; z-index: 1; }
+
+/* Clear is no colour: a knockout. Checkered, as transparency is everywhere. */
+.palette .clear,
+.palette .chip.clear {
+  background-color: #fff;
+  background-image:
+    linear-gradient(45deg, #c9c9c5 25%, transparent 25%, transparent 75%, #c9c9c5 75%),
+    linear-gradient(45deg, #c9c9c5 25%, transparent 25%, transparent 75%, #c9c9c5 75%);
+  background-size: 8px 8px;
+  background-position: 0 0, 4px 4px;
+}
+.palette .cell.clear { grid-column: span 2; width: 36px; }
+
+/* --------------------------------------------------------------------------
+   on the stage: the tools' marks, in stage pixels (the SVG's viewBox), and their
+   cursors. Hairlines, so the pixels under them can be judged. */
+
+.paint-overlay.tool-pen {
+  cursor: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' width='22' height='22'%3E%3Cpath d='M2 2 L9 5 L14 11 L11 14 L5 9 Z' fill='%23111' stroke='%23fff' stroke-width='1.2' stroke-linejoin='round'/%3E%3Cpath d='M2 2 L7 7' stroke='%23fff' stroke-width='1'/%3E%3C/svg%3E") 2 2, crosshair;
+}
+.paint-overlay.tool-pen.closing {
+  cursor: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' width='22' height='22'%3E%3Cpath d='M2 2 L9 5 L14 11 L11 14 L5 9 Z' fill='%23111' stroke='%23fff' stroke-width='1.2' stroke-linejoin='round'/%3E%3Ccircle cx='17' cy='17' r='3' fill='none' stroke='%23111' stroke-width='1.6'/%3E%3Ccircle cx='17' cy='17' r='3' fill='none' stroke='%23fff' stroke-width='.6'/%3E%3C/svg%3E") 2 2, crosshair;
+}
+.paint-overlay.tool-brush, .paint-overlay.tool-eraser { cursor: none; }
+
+.paint-overlay .footprint { fill: none; stroke: #fff1be; stroke-width: 0.5; vector-effect: non-scaling-stroke; pointer-events: none; }
+.paint-overlay .footprint.eraser { stroke-dasharray: 3 2; }
+
+.paint-overlay .draft polyline { fill: none; stroke: #fff1be; stroke-width: 1; vector-effect: non-scaling-stroke; pointer-events: none; }
+.paint-overlay .draft .first { fill: #161820; stroke: #fff1be; stroke-width: 0.5; pointer-events: none; }
+.paint-overlay .draft .first.closing { fill: #fff1be; r: 2.6; }
+
+.paint-overlay .points .outline { fill: none; stroke: #fff1be; stroke-width: 1; stroke-opacity: .55; vector-effect: non-scaling-stroke; pointer-events: none; }
+.paint-overlay .points .vertex { fill: #fff1be; stroke: #161820; stroke-width: 0.5; cursor: move; }
+.paint-overlay .points .vertex:hover { fill: #fff; r: 2.4; }
+.paint-overlay .points .insert { fill: #161820; stroke: #fff1be; stroke-width: 0.5; pointer-events: none; }
+
+/* Blender's Adjust Last Operation: the last stroke's settings, in the corner of
+   the view it was made in, until something else is done. */
+.adjust-last {
+  position: absolute;
+  left: 10px; bottom: 10px;
+  display: flex; align-items: center; gap: 10px;
+  padding: 5px 9px;
+  background: var(--pane);
+  border: 1px solid var(--line);
+  border-radius: 4px;
+  box-shadow: 0 2px 8px rgba(0, 0, 0, .25);
 }