Merge master drawing tools with tracing layers

frontend/package-lock.json

@@ -9,6 +9,7 @@
       "version": "0.0.1",
       "dependencies": {
         "@mediapipe/tasks-vision": "1.0.1",
+        "polygon-clipping": "^0.15.7",
         "react": "^18.3.1",
         "react-dom": "^18.3.1"
       },
@@ -1015,6 +1016,16 @@
         "node": ">= 0.10"
       }
     },
+    "node_modules/polygon-clipping": {
+      "version": "0.15.7",
+      "resolved": "https://registry.npmjs.org/polygon-clipping/-/polygon-clipping-0.15.7.tgz",
+      "integrity": "sha512-nhfdr83ECBg6xtqOAJab1tbksbBAOMUltN60bU+llHVOL0e5Onm1WpAXXWXVB39L8AJFssoIhEVuy/S90MmotA==",
+      "license": "MIT",
+      "dependencies": {
+        "robust-predicates": "^3.0.2",
+        "splaytree": "^3.1.0"
+      }
+    },
     "node_modules/possible-typed-array-names": {
       "version": "1.1.0",
       "resolved": "https://registry.npmjs.org/possible-typed-array-names/-/possible-typed-array-names-1.1.0.tgz",
@@ -1216,6 +1227,12 @@
         "node": ">= 0.8"
       }
     },
+    "node_modules/robust-predicates": {
+      "version": "3.0.3",
+      "resolved": "https://registry.npmjs.org/robust-predicates/-/robust-predicates-3.0.3.tgz",
+      "integrity": "sha512-NS3levdsRIUOmiJ8FZWCP7LG3QpJyrs/TE0Zpf1yvZu8cAJJ6QMW92H1c7kWpdIHo8RvmLxN/o2JXTKHp74lUA==",
+      "license": "Unlicense"
+    },
     "node_modules/safe-buffer": {
       "version": "5.2.1",
       "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz",
@@ -1416,6 +1433,15 @@
         "source-map": "^0.5.6"
       }
     },
+    "node_modules/splaytree": {
+      "version": "3.2.3",
+      "resolved": "https://registry.npmjs.org/splaytree/-/splaytree-3.2.3.tgz",
+      "integrity": "sha512-7OXrNWzy6CK+r7Ch9OLPBDTKfB6XlWHjX4P0RU5B3IgFuWPeYN0XtRtlexGRjgbQxpfaUve6jTAwBGWuGntz/w==",
+      "license": "MIT",
+      "engines": {
+        "node": ">=18.20 || >=20"
+      }
+    },
     "node_modules/stream-browserify": {
       "version": "2.0.2",
       "resolved": "https://registry.npmjs.org/stream-browserify/-/stream-browserify-2.0.2.tgz",

frontend/package.json

@@ -10,6 +10,7 @@
   },
   "dependencies": {
     "@mediapipe/tasks-vision": "1.0.1",
+    "polygon-clipping": "^0.15.7",
     "react": "^18.3.1",
     "react-dom": "^18.3.1"
   },

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

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

frontend/src/arthur/domain/clip.cljs

@@ -254,6 +254,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."
@@ -392,6 +439,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
@@ -405,7 +455,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)]
@@ -447,7 +497,8 @@
                                                        (when (and context? (:palette n))
                                                          (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/cut.cljs

@@ -0,0 +1,74 @@
+(ns arthur.domain.cut
+  "The eraser's cut: a shape's ring with a stroke taken out of it.
+
+  Illustrator's and Flash's eraser, not a raster one: what is left is the
+  SHAPE, with the cut edge made of its own points — points the pen moves, keys
+  and tweens like any others. A cut through the middle leaves two pieces, and
+  a cut inside it leaves a hole, which is bridged into the one ring as a brush
+  stroke's is (see `outline`).
+
+  In stage pixels, on both sides: the preview cuts the rings it is about to
+  draw, and the saved cut cuts the same rings and takes the answer back into
+  the shape's own coordinates — one function, so the preview is the result."
+  (:require ["polygon-clipping" :as clipping]
+            [arthur.domain.channel :as channel]
+            [arthur.domain.nest :as nest]
+            [arthur.domain.node :as node]
+            [arthur.domain.outline :as outline]
+            [arthur.domain.paint :as paint]))
+
+(defn- area [ring]
+  (let [ps (vec (partition 2 ring)) n (count ps)]
+    (js/Math.abs (/ (reduce + (map (fn [i] (let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))]
+                                             (- (* ax by) (* bx ay))))
+                                   (range n)))
+                    2))))
+
+(defn cut
+  "Ring `ring` with `cutters` — each `[outer & holes]` — taken out of it: one
+  ring per piece left, biggest first, an empty vector when nothing is left, or
+  nil when the cut does not touch it."
+  [ring cutters]
+  (let [shape  #js [(outline/->js ring)]
+        knife  (into-array (map #(into-array (map outline/->js %)) cutters))]
+    (when (seq (array-seq (clipping/intersection shape knife)))
+      (->> (array-seq (clipping/difference shape knife))
+           (map (fn [^js poly] (mapv outline/->ring (array-seq poly))))
+           (sort-by (comp - area first))
+           (mapv outline/join)))))
+
+(defn- through [m pts]
+  (let [out (js/Float64Array. 2)]
+    (into [] (mapcat (fn [[x y]] (node/apply-pt! out 0 m x y) [(aget out 0) (aget out 1)]))
+          (partition 2 pts))))
+
+(defn erase
+  "`clip` with `cutters`, in the stage pixels of symbol `open` at frame `f`,
+  cut out of each shape at row path in `paths`, on the frame each is showing.
+
+  The shape keeps the biggest piece, on a key at that frame — made there if
+  the frame had none, so the keys either side keep their points. Every other
+  piece is a new shape of the same colour, its id the next of `ids`. A shape
+  cut away entirely is deleted."
+  [clip store open f paths cutters ids]
+  (first
+   (reduce
+    (fn [[clip ids] path]
+      (let [{:keys [sid id frame world]} (nest/placement clip store open path f)
+            n    (get-in clip [:symbols sid :nodes id])
+            geom (get-in n [:channels paint/geometry])
+            inv  (when world (node/invert world))
+            left (when (and inv geom)
+                   (cut (through world (channel/value-at geom frame store)) cutters))]
+        (cond
+          (nil? left)   [clip ids]
+          (empty? left) [(nest/delete-node clip sid id) ids]
+          :else
+          (let [[keep & more] (map #(through inv %) left)
+                colour (channel/value-at (get-in n [:channels [:style :color]]) frame store)
+                kept   (-> (if (contains? (:keys geom) frame) clip (paint/add-key clip sid id frame))
+                           (paint/set-points sid id frame keep))]
+            [(reduce (fn [c [nid pts]] (paint/new-shape c sid nid frame pts colour))
+                     kept (map vector ids more))
+             (drop (count more) ids)]))))
+    [clip ids] paths)))

frontend/src/arthur/domain/outline.cljs

@@ -0,0 +1,293 @@
+(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
+  fit can change after the stroke, and `polygon` is the one place it is fitted
+  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.
+
+  FITTED TO A TOLERANCE, not cut to a count: every point of the traced edge is
+  within so many pixels of the polygon (Douglas-Peucker), so points go where
+  the shape bends and none are spent on a straight run."
+  (:require ["polygon-clipping" :as clipping]
+            [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- area
+  "The area inside ring `pts`, by the shoelace."
+  [pts]
+  (let [ps (vec (partition 2 pts)) n (count ps)]
+    (js/Math.abs (/ (reduce + (map (fn [i] (let [[ax ay] (ps i) [bx by] (ps (mod (inc i) n))]
+                                             (- (* ax by) (* bx ay))))
+                                   (range n)))
+                    2))))
+
+(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- dp
+  "Douglas-Peucker over the open run of points `i`..`j` of `xs`/`ys`: the
+  indices kept so that no point between is further than `tol` from the line."
+  [^js xs ^js ys i j tol]
+  (let [ax (aget xs i) ay (aget ys i) bx (aget xs j) by (aget ys j)
+        dx (- bx ax) dy (- by ay) l (js/Math.hypot dx dy)
+        [k d] (reduce (fn [[_ best :as acc] k]
+                        (let [px (- (aget xs k) ax) py (- (aget ys k) ay)
+                              e  (if (zero? l) (js/Math.hypot px py) (/ (js/Math.abs (- (* dx py) (* dy px))) l))]
+                          (if (< best e) [k e] acc)))
+                      [nil 0] (range (inc i) j))]
+    (if (and k (< tol d))
+      (into (dp xs ys i k tol) (rest (dp xs ys k j tol)))
+      [i j])))
+
+(defn fit
+  "Ring `pts` with as few points as keep every point of it within `tol` pixels
+  of the result: Douglas-Peucker, closed by splitting at the point furthest from
+  the first. A pixel staircase within a pixel of a diagonal becomes the
+  diagonal, and a square corner stays — the points go where the shape bends."
+  [pts tol]
+  (let [c (quot (count pts) 2)]
+    (if (<= c 3)
+      (vec pts)
+      (let [xs (js/Float64Array. (take-nth 2 pts)) ys (js/Float64Array. (take-nth 2 (rest pts)))
+            far (apply max-key #(js/Math.hypot (- (aget xs %) (aget xs 0)) (- (aget ys %) (aget ys 0)))
+                       (range c))
+            xs2 (js/Float64Array. (inc c)) ys2 (js/Float64Array. (inc c))
+            _ (dotimes [k c] (aset xs2 k (aget xs k)) (aset ys2 k (aget ys k)))
+            _ (do (aset xs2 c (aget xs 0)) (aset ys2 c (aget ys 0)))
+            keep (into (dp xs2 ys2 0 far tol) (rest (butlast (dp xs2 ys2 far c tol))))]
+        (if (< (count keep) 3)
+          (vec pts)
+          (into [] (mapcat (fn [k] [(aget xs k) (aget ys k)])) keep))))))
+
+(defn- crosses?
+  "Does any edge of ring `a` cross any edge of ring `b`?"
+  [a b]
+  (let [edges (fn [r] (let [ps (vec (partition 2 r)) n (count ps)]
+                        (map (fn [i] [(ps i) (ps (mod (inc i) n))]) (range n))))
+        side  (fn [[ax ay] [bx by] [px py]] (- (* (- bx ax) (- py ay)) (* (- by ay) (- px ax))))]
+    (some (fn [[p q]]
+            (some (fn [[r s]]
+                    (and (neg? (* (side p q r) (side p q s)))
+                         (neg? (* (side r s p) (side r s q)))))
+                  (edges b)))
+          (edges a))))
+
+(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 ->js
+  "Flat ring `ring` as `polygon-clipping` takes one."
+  [ring]
+  (into-array (map into-array (partition 2 ring))))
+
+(defn ->ring
+  "A ring back from `polygon-clipping`, flat, without the point it repeats to
+  close."
+  [^js r]
+  (into [] (mapcat identity) (butlast (map vec (array-seq r)))))
+
+(defn rings-of
+  "Piece `p` of `pieces` fitted to within `tol` pixels, outside first, holes
+  after.
+
+  EVERY HOLE IS KEPT, and kept simple: fitted like the outside, then clipped to
+  the inside of it and clear of the holes before it. Fitting each ring on its
+  own can push a hole's edge across the outside's, and a crossing is what makes
+  the even-odd fill cut through the body; clipping takes exactly that part off
+  and leaves the few points the fit chose. Fitting closer until nothing crossed
+  was tried, and spent hundreds of points on what is plainly a straight line."
+  [{:keys [outer holes]} tol]
+  (let [outer (fit outer tol)]
+    (reduce (fn [rs hole]
+              (let [h (fit hole tol)]
+                (if (not-any? #(crosses? h %) rs)
+                  (conj rs h)
+                  (let [inside (clipping/intersection #js [(->js h)] #js [(->js outer)])
+                        clear  (if (next rs)
+                                 (clipping/difference inside (into-array (map #(array (->js %)) (rest rs))))
+                                 inside)]
+                    (into rs (comp (map #(->ring (aget % 0))) (filter #(< 2 (area %))))
+                          (array-seq clear))))))
+            [outer]
+            (sort-by (comp - area) holes))))
+
+(defn join
+  "Rings `[outer & holes]` as one ring, each hole bridged in, leftmost first."
+  [[outer & holes]]
+  (reduce bridge outer (sort-by #(apply min (take-nth 2 %)) holes)))
+
+(defn polygon
+  "Piece `p` of `pieces` as the one ring a shape is made of. See `rings-of`."
+  [p tol]
+  (join (rings-of p tol)))

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

@@ -63,19 +63,8 @@
                (and (<= 0 u) (< u w) (<= 0 v) (< v h))))
     false))
 
-(defn hit
+(defn- op-bounds [{:keys [kind pts n cx cy r size knock lut] :as op}]
-  "The row path of the topmost op in `ops`, in draw order, at stage point `[x y]`,
+  (case (when-not (or knock lut) kind)
-  or nil.
-
-  WHAT IS DRAWN WINS OVER A REFERENCE. A tracing photo usually covers the whole
-  stage and is painted over the picture, so topmost-first would make every click
-  land on it; a trace is picked only where nothing drawn is under the pointer."
-  [ops [x y]]
-  (let [{traces true drawn false} (group-by #(= :trace (:kind %)) (rseq (vec ops)))]
-    (some #(when (on? % x y) (path-of %)) (concat drawn traces))))
-
-(defn- op-bounds [{:keys [kind pts n cx cy r size] :as op}]
-  (case kind
     :trace (let [cs (trace-corners op)]
              [(apply min (map first cs)) (apply min (map second cs))
               (apply max (map first cs)) (apply max (map second cs))])
@@ -105,6 +94,29 @@
 (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
+                   ;; A remap is light on what is under it, not a thing.
+                   (or (:lut op) (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})))
+               [] (let [{traces true drawn false} (group-by #(= :trace (:kind %)) (rseq (vec ops)))]
+                    (concat drawn traces)))))
+
+(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,53 @@
   (.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.
+;;
+;; THE INK is how a shape marks the pixels it covers, and there are three, as
+;; Deluxe Paint and Animator Pro had inks:
+;;
+;;   nil              an ordinary fill: write the shape's index
+;;   a number         a knockout: clear coverage — of every colour at -1, or of
+;;                    that index only
+;;   a Uint8Array     a REMAP, index -> index: what is already there is drawn
+;;                    in another slot. A flashlight is a circle of this.
+
+(defn- plot! [^js buf cov o index ink]
+  (cond
+    (nil? ink)    (do (aset buf o index)
+                      (when cov (aset cov o 1)))
+    (number? ink) (when (and cov (or (neg? ink) (== (aget buf o) ink)))
+                    (aset cov o 0))
+    :else         (aset buf o (aget ink (aget buf o)))))
+
+(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 +82,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. `ink` 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 ink]
   (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 +126,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 ink)))))))))
-  r)
+  r))
 
 (defn fill-poly!
   "`fill-poly-buf!` over a seq of {:x :y} points.
@@ -99,8 +147,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 ink]
    (let [rr (* rad rad)
          y0 (max 0 (js/Math.floor (- cy rad)))
          y1 (min (dec h) (js/Math.ceil (+ cy rad)))
@@ -114,8 +163,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 ink)))))))
      r)))
 
 (defn fill-rect!
@@ -132,8 +181,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 ink]
    (let [size (js/Math.round size)]
      (when (>= size 1)
        (let [x0 (js/Math.round (- cx (/ size 2)))
@@ -143,8 +193,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 ink))))))))
    r))
 
 (def ^:private little-endian?
@@ -223,6 +273,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 ink]
+  (dotimes [o (.-length mask)]
+    (when (== 1 (aget mask o))
+      (plot! buf cov o index ink)))
+  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 +301,26 @@
   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 and `:lut` a remap. 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] :as op}]
-      (throw (ex-info "draw op kind is not rasterisable" {:op (dissoc op :pts)}))))
+     (let [top (peek stack)
+           ink (or (:knock op) (:lut op))]
+       (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 ink) stack)
+         :disc  (do (fill-disc! top cx cy (:r op) color stencil ink) stack)
+         :rect  (do (fill-rect! top cx cy size color stencil ink) stack)
+         :mask  (do (fill-mask! top (:mask op) color ink) 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,41 @@
     (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 remap?
+  "Is colour `c` a REMAP: `[:remap {from to …}]`, slots of the palette in
+  scope? It draws nothing of its own; what is already under it is drawn in
+  other slots — a flashlight is a circle of this. See `raster/plot!`."
+  [c]
+  (and (vector? c) (= :remap (first c))))
+
+(defn- knock-index [palette c]
+  (if (= :clear c) -1 (colour-index palette (second c))))
+
+(defn lut
+  "Remap `[:remap m]` as a raster index -> index table in `palette`. Slots of
+  any other palette are left as they are."
+  [palette [_ m]]
+  (let [t (js/Uint8Array. 256)]
+    (dotimes [i 256] (aset t i i))
+    (doseq [[a b] m] (aset t (colour-index palette a) (colour-index palette b)))
+    t))
+
+(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 +436,14 @@
   "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])]
+                   (cond
+                     (knockout? c) (assoc op :knock (knock-index palette c) :color 0)
+                     (remap? c)    (assoc op :lut (lut palette c) :color 0)
+                     :else         (assoc op :color (colour-index palette c)))))]
     (case (:kind n)
       :group nil
       :instance nil
@@ -415,23 +457,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

@@ -20,9 +20,11 @@
             [arthur.domain.channel :as ch]
             [arthur.domain.clipboard :as clipboard]
             [arthur.domain.correction :as correction]
+            [arthur.domain.cut :as cut]
             [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 +72,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)))
 
@@ -425,7 +427,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] [])))))
@@ -498,24 +500,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.
@@ -583,56 +632,153 @@
                              (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 fitted to within `:fit` pixels
+;; of what was painted — points where it bends, none on a straight run. What
+;; it was made from is kept in `[:ui :last]`, Blender's Adjust Last Operation,
+;; so the fit can be changed afterwards from the trace rather than from the
+;; points already thrown away, until something else is done.
+
+(def default-fit 1)
+
+(defn- stroke-points [pieces fit]
+  (mapv #(outline/polygon % fit) pieces))
 
 (rf/reg-event-db
- ::finish-polygon
+ ::fit
- ;; The drawing already exists from `::begin-polygon`; finishing commits only
+ (fn [db [_ fit]] (assoc-in db [:ui :fit] (-> fit (max 0.5) (min 8)))))
- ;; the shape, so cancelling a draft does not undo the drawing that was started.
+
- (fn [db _]
+(defn- saved [db] (:clip (store/entry (:clip/current db))))
-   (let [draft (get-in db [:ui :draft])
+
-         open  (get-in db [:ui :open])
+(defn- fresh-ids [] (repeatedly #(keyword (str "paint-" (random-uuid)))))
-         {clip :clip st :store} (store/entry (:clip/current db))
+
-         landing (polygon-landing clip st db)
+(defn- erasing
-         source  (:clip landing)
+  "`db` with `pieces` cut out of the shapes at `paths`. See `cut/erase`."
-         down    (:path landing)
+  [db before pieces fit paths ids]
-         {:keys [sid frame pts]}
+  (let [{st :store} (store/entry (:clip/current db))
-         (when-not (:refused landing)
+        cutters (mapv #(outline/rings-of % fit) pieces)]
-           (nest/drawn-inside source st open down (editing-frame db source) draft))]
+    (edit/transaction db (fn [_] (cut/erase before st (get-in db [:ui :open])
-     (cond
+                                            (editing-frame db before) paths cutters ids)))))
-       (< (count draft) 6) db
+
-       (:refused landing) (update db :project merge {:status (:refused landing)})
+(rf/reg-event-db
-       (nil? sid)
+ ::stroke
-       (update db :project merge
+ ;; The brush draws in the tone, into the creation target, as the pen does.
-               {:status (if (:lane? landing)
+ ;; With `paths` it is the eraser's, and cuts the shapes they lead to.
-                          "this sequence is not on screen at this frame"
+ (fn [db [_ {:keys [pieces paths]}]]
-                          "what you are drawing into is not on screen at this frame")})
+   (let [fit (get-in db [:ui :fit] default-fit)
-       ;; `random-uuid` is the one impurity in this namespace, and it is here
+         before  (saved db)]
-       ;; rather than in `domain/paint` for the reason `clip/place-symbol` spells
+     (if paths
-       ;; out: a node's id is its identity in the saved document, so the pure
+       (let [ids (vec (take 64 (fresh-ids)))
-       ;; layer must be handed one rather than invent one. If replaying the event
+             db  (erasing db before pieces fit paths ids)]
-       ;; log ever has to reproduce a document exactly, this becomes a cofx.
+         (assoc-in db [:ui :last] {:kind :eraser :pieces pieces :paths paths :ids ids
-       :else
+                                   :fit fit :before before :after (saved db)}))
-       (let [id (keyword (str "paint-" (random-uuid)))]
+       (let [{:keys [refused clip sid frame] :as at} (when (seq pieces)
-         ;; NOTHING IS OPENED HERE. Finishing a shape used to expand every row
+                                                        (landing-into db nil (stroke-points pieces fit)))
-         ;; between the open symbol and the new shape, which inside a lane meant
+             ids (vec (take (count pieces) (fresh-ids)))]
-         ;; tearing the lane's one row open into its portal, that clip's
+         (cond
-         ;; channels and every shape already in the drawing — a dozen rows, in
+           (empty? pieces) db
-         ;; answer to a gesture that said nothing about the outline. Expansion
+           refused (update db :project merge {:status refused})
-         ;; is the twist triangle's business and nobody else's; the shape is
+           :else
-         ;; selected and on the stage with handles on it, which is where you
+           (let [db (-> db
-         ;; were looking.
+                        (edit/transaction
-         (-> db
+                         (fn [_] (reduce (fn [c [id pts]]
-             (edit/transaction
+                                           (paint/new-shape c sid id frame pts (get-in db [:ui :tone])))
-              (fn [_] (paint/new-shape source sid id frame pts (get-in db [:ui :tone]))))
+                                         clip (map vector ids (:rings at)))))
-             (update :ui merge {:tool nil :draft []})
+                        (selected [:node sid (peek ids) (conj (:down at) (peek ids))]))]
-             (selected [:node sid id (conj down id)])))))))
+             (assoc-in db [:ui :last] {:kind :brush :pieces pieces :fit fit
+                                       :down (:down at) :sid sid :frame frame :ids ids
+                                       :after (saved db)}))))))))
+
+(rf/reg-event-db
+ ::adjust-last
+ ;; The last stroke's fit, 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 [_ fit]]
+   (let [{:keys [kind pieces paths ids down sid frame before after]} (get-in db [:ui :last])
+         ;; Only while the document is still what the stroke left it as.
+         db (assoc-in db [:ui :fit] fit)]
+     (if-not (and pieces (identical? after (saved db)))
+       db
+       (let [db (if (= :eraser kind)
+                  (erasing db before pieces fit paths ids)
+                  (let [at (landing-into db down (stroke-points pieces fit))]
+                    (edit/transaction
+                     db (fn [c] (reduce (fn [c [id pts]] (paint/set-points c sid id frame pts))
+                                        c (map vector ids (:rings at)))))))]
+         (update-in db [:ui :last] assoc :fit fit :after (saved 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
@@ -1031,14 +1177,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)))
@@ -1121,17 +1259,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/render.cljs

@@ -204,4 +204,3 @@
          (pre-frame-of [_ path] (symbol/pre-frame-of resolve path))
          clip/IActivePalette
          (active-palette [_] (clip/active-palette resolve)))))))
-

frontend/src/arthur/subs/ui.cljs

@@ -29,15 +29,29 @@
 (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 ::fit   (fn [db _] (get-in db [:ui :fit] 1)))
+(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-id]
+ :<- [::render/paint-revision]
+ ;; The last stroke while the document is still what it left: any other edit,
+ ;; or an undo, takes the panel away, as Blender's goes with the next operation.
+ (fn [[op id _] _]
+   (when (and op (identical? (:after op) (:clip (store/entry id)))) op)))
 
 (rf/reg-sub
  ::selected-node
@@ -56,17 +70,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
  ::own-time

frontend/src/arthur/ui/palette.cljs

@@ -1,101 +1,194 @@
 (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.channel :as channel]
-  with the selection. See `ui/params`."
-  (:require [arthur.domain.palette :as pal]
             [arthur.domain.node :as node]
-            [arthur.events.ui :as ui]
+            [arthur.domain.palette :as pal]
+            [arthur.domain.symbol :as symbol]
             [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]
-            [re-frame.core :as rf]))
+            [reagent.core :as r]))
 
 (rf/reg-sub ::chosen (fn [db _] (get-in db [:ui :palette])))
 
-(defn- swatch [pid i {:keys [name hex]} tone placements]
+(rf/reg-event-db ::select (fn [db [_ id]] (assoc-in db [:ui :palette] id)))
-  (let [picker-id (str "palette-picker-" pid "-" i)]
+
-    [:div {:key i :class "palette-slot"}
+(defn- shown
-     [:button {:class (str "swatch" (when (= i tone) " on"))
+  "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]))))
+
+;; ---------------------------------------------------------------------------
+;; remap: a shape that lights what is under it
+;;
+;; A shape coloured `[:remap {from to …}]` draws nothing of its own: whatever is
+;; already under it is drawn in other slots of the same palette, as Deluxe
+;; Paint's and Animator Pro's shade inks did. A flashlight is a circle of it.
+;; Pick MAP from the strip and draw one; its map is set in the inspector, or by
+;; dragging one swatch of the strip onto another while it is selected.
+
+(defn- remap
+  "The selected node when it is a remap shape, with its map at the frame shown:
+  `{:sid :id :frame :keys :map}`, or nil."
+  []
+  (let [[sid id n] @(rf/subscribe [::sub/selected-node])
+        frame      (:frame @(rf/subscribe [::sub/selected-local]))
+        ch         (get-in n [:channels [:style :color]])
+        c          (when ch (channel/value-at ch (or frame 0) nil))]
+    (when (symbol/remap? c)
+      {:sid sid :id id :frame frame :keys (:keys ch) :map (second c)})))
+
+(defn- map-slot!
+  "Light `from` as `to` under the selected remap shape; as itself, not at all."
+  [{:keys [sid id frame map]} from to]
+  (rf/dispatch [::project/set-channel sid id [:style :color] frame
+                [:remap (if (= from to) (dissoc map from) (assoc map from to))]]))
+
+(defn remap-section
+  "The inspector's map for a selected remap shape: each slot as what is under
+  the shape will be drawn in, the original in its corner where it is changed.
+  A slot opens a choice of what to draw it as."
+  []
+  (r/with-let [open (r/atom nil)]
+    (let [[_ _ palette] (shown)
+          {:keys [sid id frame keys] m :map :as rm} (remap)
+          slots (:slots palette)
+          hex   #(:hex (get slots %))]
+      (when rm
+        [:section.section
+         [:h2 "remap"]
+         [:div.remap-head
+          [:button.key {:class (cond (contains? keys frame) "on" keys "keyed")
+                        :disabled (nil? frame)
+                        :title (if keys (str (count keys) " held keys") "key the map here")
+                        :on-click #(rf/dispatch [::project/toggle-key sid id [:style :color] frame])}
+           "◆"]
+          [:span.dim (if (seq m)
+                       (str "what is under it: " (count m) " slot" (when (< 1 (count m)) "s") " changed")
+                       "changes nothing yet — pick a slot")]
+          [:span {:style {:flex 1}}]
+          (when (seq m)
+            [:button {:on-click #(rf/dispatch [::project/set-channel sid id [:style :color] frame [:remap {}]])}
+             "reset"])]
+         [:div.remap
+          (doall
+           (for [i (range (count slots))]
+             ^{:key i}
+             [:button {:class (str "cell" (when (contains? m i) " mapped") (when (= i @open) " on"))
+                       :style {:background (hex (get m i i))}
+                       :title (str "slot " i (when (contains? m i) (str " → " (m i))))
+                       :on-click #(swap! open (fn [o] (when-not (= o i) i)))}
+              (when (contains? m i) [:i {:style {:background (hex i)}}])]))]
+         (when-let [from @open]
+           [:div.remap-pick
+            [:span.dim (str "under it, draw " from " as")]
+            (doall
+             (for [i (range (count slots))]
+               ^{:key i}
+               [:button {:class (str "cell" (when (= i (get m from from)) " on"))
+                         :style {:background (hex i)}
+                         :title (if (= i from) (str i " — as it is") (str "slot " i))
+                         :on-click #(do (map-slot! rm from i) (reset! open nil))}]))])]))))
+
+(defn- swatch [pid i {:keys [name hex]} tone placements rm hex-of]
+  (let [picker-id (str "palette-picker-" pid "-" i)
+        to (get (:map rm) i)]
+    [:div.slot {:key i}
+     [: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
-               :on-click #(do (rf/dispatch [::ui/set-tone i])
+                           (when to (str " · lit as " to " under the selected remap"))
-                              (let [edits (into [] (keep (fn [{:keys [sid id node frame]}]
+                           " — double-click to edit"
-                                                   (when (contains? (get node/valid-paths (:kind node))
+                           (when rm ", drag onto another to remap it under the selected remap"))
-                                                                    [:style :color])
+               :draggable (some? rm)
-                                                     {:sid sid :id id :path [:style :color]
+               :on-drag-start #(.setData (.-dataTransfer %) "application/x-arthur-slot" (str i))
-                                                      :frame frame :value i})))
+               :on-drag-over (fn [^js e] (when rm (.preventDefault e)))
-                                                placements)]
+               :on-drop (fn [^js e]
-                                (when (seq edits)
+                          (.preventDefault e)
-                                  (rf/dispatch [::project/set-channels edits]))))
+                          (let [from (js/parseInt (.getData (.-dataTransfer e) "application/x-arthur-slot"))]
+                            (when (and rm (not (js/isNaN from))) (map-slot! rm from i))))
+               :on-click #(pick! i placements)
                :on-double-click (fn [e]
                                   (.preventDefault e)
-                                  (some-> (js/document.getElementById picker-id) (.click)))}]
+                                  (some-> (js/document.getElementById picker-id) (.click)))}
+      (when to [:i.badge {:style {:background (hex-of to)}}])]
      [:input {:id picker-id :class "palette-picker" :type "color" :value hex
               :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" (cond (= :clear tone) " clear" (symbol/remap? tone) " map"))
-    [:div.palette-bar
+            :style (when hex {:background hex})
+            :title (cond (= :clear tone) "clear: what is drawn knocks out what is under it in its symbol"
+                         (symbol/remap? tone) "remap: what is drawn lights what is under it"
+                         :else (str "slot " tone " · " hex))}
+      [:span (cond (= :clear tone) "×" (symbol/remap? tone) "⇄" :else tone)]]
+     [:div.cells
+      (let [rm (remap) hex-of #(:hex (get (:slots palette) %))]
+        (doall (map-indexed #(swatch pid %1 %2 tone placements rm hex-of) (: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)}]]
+      [:div.slot
+       [:button {:class (str "cell map" (when (symbol/remap? tone) " on"))
+                 :title "remap — draws light: what is under it is drawn in other slots of the palette. Set which in the inspector."
+                 :on-click #(pick! [:remap {}] 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}}]
-     ;; Every tracing layer at once: the reference on or off, and how strongly
-     ;; it draws. A property of looking at the stage, like the zoom beside it.
-     (let [{:keys [on? opacity]} @(rf/subscribe [::render/tracing])]
-       [:<>
-        [:button {:class (when on? "on")
-                  :title "show tracing layers over the picture · never exported"
-                  :on-click #(rf/dispatch [::ui/tracing-on (not on?)])}
-         "tracing"]
-        [:input.trace-opacity
-         {:type "range" :min 0 :max 1 :step 0.05 :value opacity :disabled (not on?)
-          :title "how strongly tracing layers draw"
-          :style {:flex "0 0 64px"}
-          :on-change #(rf/dispatch [::ui/tracing-opacity (js/parseFloat (.. % -target -value))])}]])
-     (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/params.cljs

@@ -23,6 +23,7 @@
             [arthur.subs.playback :as playback]
             [arthur.subs.render :as render]
             [arthur.subs.ui :as sub]
+            [arthur.ui.palette :as palette]
             [re-frame.core :as rf]
             [reagent.core :as r]))
 
@@ -209,10 +210,11 @@
 (defn- color-control [sid id ch frame auto-key? palette]
   (let [keyed? (some? (:keys ch))
         value  (channel/value-at ch (or frame 0) nil)
-        value  (if (integer? value)
+        ;; A knockout or a remap is no slot, and none is marked.
-                 value
+        value  (cond
-                 (or (first (keep-indexed #(when (= value (:name %2)) %1)
+                 (integer? value) value
-                                           (:slots palette))) 0))
+                 (keyword? value) (or (first (keep-indexed #(when (= value (:name %2)) %1)
+                                                           (:slots palette))) 0))
         off?   (and keyed? (nil? frame))]
     [:dd.channel {:class (when auto-key? "live")}
      [:button.key {:class (cond (contains? (:keys ch) frame) "on" keyed? "keyed")
@@ -783,6 +785,7 @@
         [palette-placement-section node]
         [clip-section])
       (when (and node (not palette-placement?)) [node-section node])
+      (when (and node (not palette-placement?)) [palette/remap-section])
       (when (and placed (not palette-placement?)) [symbol-section placed "source symbol"])
       (when (and node (not palette-placement?)) ^{:key (str (first node) "/" (second node))}
         [correction-section node])

frontend/src/arthur/ui/player.cljs

@@ -20,12 +20,16 @@
   no global interceptors."
   (:require [arthur.clock :as clock]
             [arthur.domain.clip :as clip]
+            [arthur.domain.cut :as cut]
+            [arthur.domain.outline :as outline]
             [arthur.domain.palette :as pal]
             [arthur.domain.pick :as pick]
             [arthur.domain.raster :as raster]
+            [arthur.domain.symbol :as symbol]
             [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.tracing :as tracing]
             [re-frame.core :as rf]
@@ -103,9 +107,19 @@
   (some-> @tracker ratom/dispose!)
   (reset! tracker
           (ratom/run!
-           (let [{was :resolver was-t :tracing} @snapshot
+           (let [{was :resolver was-t :tracing :as before} @snapshot
                  now @(rf/subscribe [::render/shown])
-                 t   @(rf/subscribe [::render/tracing])]
+                 t   @(rf/subscribe [::render/tracing])
+                 ;; 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])
+                      :fit @(rf/subscribe [::ui-sub/fit])
+                      ;; 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,17 +130,36 @@
                       :height   @(rf/subscribe [::sub/height])
                       :tracing  t
                       :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.
              ;;
              ;; Switching tracing on or off wants the same redraw for the same
              ;; reason, and it needs asking for SEPARATELY: it is a viewing aid
              ;; in the editor's own state, so it changes what the canvases should
-             ;; show without touching the frame number OR the resolver.
+             ;; show without touching the frame number OR the resolver. The
-             (when-not (and (identical? was now) (= was-t t))
+             ;; document and the store are left out of the comparison because
+             ;; they are what a new resolver already means.
+             ;; 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-t t) (= 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 :paths}`, `: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
@@ -149,9 +182,83 @@
   [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 rings letting go would make of it, `[outer & holes]` per
+  piece: traced and simplified by the same function the saved shapes are, so
+  the preview IS them. Once per version of the mask and fit, not per paint."
+  [{:keys [mask version]} fit]
+  (let [key [mask version fit]]
+    (if (= key (:key @trace-cache))
+      (:rings @trace-cache)
+      (:rings (reset! trace-cache
+                      {:key key
+                       :rings (mapv #(outline/rings-of % fit) (outline/pieces mask))})))))
+
+(defn- op-path [op] (let [n (:node op)] (if (vector? n) n [n])))
+
+(defn- poly [ring op]
+  (assoc op :kind :poly :pts (into-array ring) :n (quot (count ring) 2)))
+
+(defn- cut-ops
+  "`ops` with each op of a shape at one of `paths` cut by `cutters`, as the
+  eraser will cut it."
+  [ops paths cutters]
+  (into []
+        (mapcat (fn [{:keys [pts n] :as op}]
+                  (or (when (and (= :poly (:kind op)) (contains? paths (op-path op)))
+                        (some->> (cut/cut (vec (take (* 2 n) (array-seq pts))) cutters)
+                                 (map #(poly % (dissoc op :pts :n)))))
+                      [op])))
+        ops))
+
+(defn- inked
+  "Op `op` drawn in tone `tone`: a slot's colour, or — for a remap — light on
+  what is under it, through the same table the saved shape gets."
+  [op tone palette active]
+  (if (symbol/remap? tone)
+    (assoc op :lut (symbol/lut #(index-of-slot palette active %) tone) :color 0)
+    (assoc op :color (index-of-slot palette active tone))))
+
+(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, a brush stroke as the polygons it will be, and an eraser's cut as
+  the shapes it will leave."
+  [ops palette active]
+  (let [{:keys [draft hover tone fit target]} (:pen @snapshot)
+        target (or target [])
+        pts (cond-> (vec draft) (and (seq draft) hover) (into hover))
+        {:keys [slot knock paths] :as s} @stroke
+        rings (when (:mask s) (traced s fit))]
+    (cond-> ops
+      (and (<= 6 (count pts)) (or (number? tone) (symbol/remap? tone)))
+      (clip/atop target (inked (poly pts {}) tone palette active))
+
+      paths
+      (cut-ops paths rings)
+
+      (and rings (not paths) (nil? knock))
+      (as-> ops (reduce #(clip/atop %1 target (inked (poly (outline/join %2) {}) slot palette active))
+                        ops rings))
+
+      (and rings (not paths) knock)
+      (as-> ops (reduce #(clip/in-layer %1 target (poly (outline/join %2) {:color 0 :knock knock}))
+                        ops rings)))))
+
 (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
@@ -178,7 +285,7 @@
         (swap! state assoc :ops (into (vec picture) traces))
         (-> ras
             (raster/clear! bg)
-            (raster/draw-ops! picture))
+            (raster/draw-ops! (with-previews picture palette active)))
         (js/performance.mark "arthur/blit:start")
         (canvas/blit! canvas ras (pal/effective-ramp palette active))
         (tracing/paint! traces (assoc tracing :width width :playing? playing?) repaint!))

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,8 +14,10 @@
             [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.domain.symbol :as symbol]
             [arthur.events.paint :as paint-events]
             [arthur.events.ui :as ui]
             [arthur.footage.store :as store]
@@ -26,6 +28,7 @@
             [arthur.ui.layout :as layout]
             [arthur.ui.player :as player]
             [arthur.ui.tracing :as tracing]
+            [arthur.ui.tools :as tools]
             [re-frame.core :as rf]
             [reagent.core :as r]))
 
@@ -344,10 +347,168 @@
                                :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)
+        ;; Not a bridge: a point there would open the hole. See `outline-path`.
+        there (set (map (fn [i] [(ps i) (ps (mod (inc i) n))]) (range n)))]
+    (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) (not (contains? there [[bx by] [ax ay]]))
+                         (<= (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 cuts the shapes in the symbol holding what the stroke STARTS on,
+  of the colour it starts on — Photoshop's background eraser, Flash's erase
+  fills — or, with ⌥, every one of them. Starting on nothing with ⌥ cuts in
+  the open symbol."
+  [{:keys [open f] :as ctx} tool p size tone ^js event]
+  (let [eraser? (= :eraser tool)
+        all?    (.-altKey event)
+        op      (when eraser? (player/hit-op p))
+        path    (when op (let [n (:node op)] (if (vector? n) n [n])))
+        within  (if path (pop path) [])
+        {document :clip st :store} (loaded ctx)
+        colour  #(when-let [{:keys [sid id frame]} (nest/placement document st open % f)]
+                   (when (get-in document [:symbols sid :nodes id :paint?])
+                     (channel/value-at (get-in document [:symbols sid :nodes id :channels [:style :color]])
+                                       frame st)))
+        start   (when path (colour path))
+        paths   (when (and eraser? (or all? path))
+                  (when-let [{:keys [sid]} (nest/inside document st open within f)]
+                    (into #{}
+                          (keep (fn [[id n]]
+                                  (let [q (conj within id) c (when (= :poly (:kind n)) (colour q))]
+                                    (when (and (some? c) (not (symbol/knockout? c)) (or all? (= c start)))
+                                      q))))
+                          (get-in document [:symbols sid :nodes]))))
+        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.
+                  (not eraser?) {:mask m :slot tone :knock (when (= :clear tone) -1)}
+                  (seq paths)   {:mask m :paths paths})]
+    (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 paths]} @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) :paths paths}])
+    (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- outline-path
+  "Ring `pts` as an SVG path, without its bridges: an edge the ring runs along
+  both ways is where a hole is joined to the outside (see `domain/outline`),
+  which the fill never draws and the outline should not either."
+  [pts]
+  (let [ps (pairs pts) n (count ps)
+        edges (map (fn [i] [(ps i) (ps (mod (inc i) n))]) (range n))
+        there (set edges)]
+    (apply str (for [[a b] edges :when (not (contains? there [b a]))]
+                 (str "M" (first a) "," (second a) "L" (first b) "," (second b))))))
+
+(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
+       [:path.outline {:d (outline-path 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 +520,92 @@
              ;; 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] (editing)
+        selected-pts (when (and egeom matrix)
+                       (let [pts (channel/value-at egeom eframe (:store (loaded ctx)))]
+                         (when-not (channel/nothing? pts)
+                           (through matrix pts))))
+        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 +616,13 @@
                                     (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)
+     (when (seq selected-pts)
-       [:polyline {:points (points-text draft) :fill "none"
+       [:polygon.selected-paint-outline
-                   :stroke "#d0ba86" :stroke-width 1}])
+        {:points (points-text selected-pts) :pointer-events "none"}])
      (when mark
        (let [[[x0 y0] [x1 y1]] [(:p0 mark) (:p mark)]]
          [:rect.marquee {:x (min x0 x1) :y (min y0 y1)
@@ -444,26 +631,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 +678,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,132 @@
+(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.subs.render :as render]
+            [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 "cuts the shapes of the colour you start on, in its symbol · ⌥ cuts 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- fit-control
+  "How closely a stroke's polygon follows what was painted: every point of the
+  painted edge within so many pixels of it. Closer is more points, and only
+  where the shape bends."
+  [fit event]
+  [:label.option {:title "how far the polygon may stray from what you painted — closer is more points, only where it bends"}
+   "fit within"
+   [:input {:type "range" :min 0.5 :max 8 :step 0.5 :value fit
+            :on-change #(rf/dispatch [event (js/parseFloat (.. % -target -value))])}]
+   [:span.value (str fit "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]
+                         [fit-control @(rf/subscribe [::sub/fit]) ::ui/fit]
+                         [:span.dim.hint tip]]
+       (if (< 1 (count selections))
+         [:span.dim (str (count selections) " selected")]
+         [:span.dim.hint tip]))
+     [:span.spacer]
+     [palette/assets]
+     (let [{:keys [on? opacity]} @(rf/subscribe [::render/tracing])]
+       [:<>
+        [:button {:class (when on? "on")
+                  :title "show tracing layers over the picture · never exported"
+                  :on-click #(rf/dispatch [::ui/tracing-on (not on?)])} "tracing"]
+        [:input.trace-opacity
+         {:type "range" :min 0 :max 1 :step 0.05 :value opacity :disabled (not on?)
+          :title "how strongly tracing layers draw" :style {:flex "0 0 64px"}
+          :on-change #(rf/dispatch [::ui/tracing-opacity (js/parseFloat (.. % -target -value))])}]])
+     ;; 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 fit,
+  changeable until something else is done."
+  []
+  (when-let [{:keys [kind ids fit]} @(rf/subscribe [::sub/last])]
+    [:div.adjust-last
+     [:strong (if (= :eraser kind) "Erase" "Brush stroke")]
+     (when (and (= :brush kind) (< 1 (count ids))) [:span.dim (str (count ids) " pieces")])
+     [fit-control fit ::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/cut_test.cljs

@@ -0,0 +1,63 @@
+(ns arthur.domain.cut-test
+  (:require [cljs.test :refer [deftest is]]
+            [arthur.domain.channel :as channel]
+            [arthur.domain.clip :as clip]
+            [arthur.domain.cut :as cut]
+            [arthur.domain.paint :as paint]
+            [arthur.domain.raster :as r]))
+
+(def square [10 10 50 10 50 50 10 50])
+
+(defn- ink [ring]
+  (let [b (:buf (r/fill-poly-buf! (r/make 60 60) ring (quot (count ring) 2) 1))]
+    (fn [x y] (aget b (+ x (* y 60))))))
+
+(deftest a-cut-off-the-side-keeps-the-rest-with-the-cut-edge-as-its-points
+  (let [[left & more] (cut/cut square [[[40 0 60 0 60 60 40 60]]])]
+    (is (empty? more))
+    (is (= 1 ((ink left) 20 30)))
+    (is (= 0 ((ink left) 45 30)))
+    (is (some #{40} (take-nth 2 left)) "the cut edge is the shape's own points")))
+
+(deftest a-cut-through-the-middle-leaves-two-pieces-biggest-first
+  (let [pieces (cut/cut square [[[25 0 30 0 30 60 25 60]]])]
+    (is (= 2 (count pieces)))
+    (is (= 1 ((ink (first pieces)) 40 30)) "the right side is the bigger")
+    (is (= 1 ((ink (second pieces)) 15 30)))))
+
+(deftest a-cut-inside-leaves-a-hole-in-one-ring
+  (let [[ring & more] (cut/cut square [[[25 25 35 25 35 35 25 35]]])]
+    (is (empty? more))
+    (is (= 0 ((ink ring) 30 30)))
+    (is (= 1 ((ink ring) 15 30)))))
+
+(deftest a-cut-that-misses-is-nil-and-one-that-takes-everything-is-empty
+  (is (nil? (cut/cut square [[[0 0 5 0 5 5 0 5]]])))
+  (is (= [] (cut/cut square [[[0 0 60 0 60 60 0 60]]]))))
+
+(deftest a-ring-with-a-bridged-hole-cuts-like-the-shape-it-draws
+  (let [holed (first (cut/cut square [[[25 25 35 25 35 35 25 35]]]))
+        [ring] (cut/cut holed [[[0 0 20 0 20 60 0 60]]])]
+    (is (= 0 ((ink ring) 30 30)) "the hole is still a hole")
+    (is (= 0 ((ink ring) 15 30)))
+    (is (= 1 ((ink ring) 45 30)))))
+
+(deftest erasing-keeps-the-big-piece-on-the-shape-and-makes-the-rest-new
+  (let [clip (-> (clip/blank) (paint/new-shape :main :s 0 square 3))
+        out  (cut/erase clip nil :main 0 [[:s]] [[[25 0 30 0 30 60 25 60]]] [:t :u])
+        nodes (get-in out [:symbols :main :nodes])
+        pts  #(channel/value-at (get-in nodes [% :channels paint/geometry]) 0 nil)]
+    (is (= #{:s :t} (set (keys nodes))))
+    (is (= 1 ((ink (pts :s)) 40 30)))
+    (is (= 1 ((ink (pts :t)) 15 30)))
+    (is (= 3 (channel/value-at (get-in nodes [:t :channels [:style :color]]) 0 nil)))
+    (is (= {} (get-in (cut/erase clip nil :main 0 [[:s]] [[[0 0 60 0 60 60 0 60]]] [])
+                      [:symbols :main :nodes]))
+        "cut away entirely, it is gone")))
+
+(deftest erasing-between-keys-keys-the-frame-and-leaves-the-others
+  (let [clip (-> (clip/blank) (paint/new-shape :main :s 0 square 3) (paint/add-key :main :s 10))
+        out  (cut/erase clip nil :main 5 [[:s]] [[[40 0 60 0 60 60 40 60]]] [])
+        ks   (get-in out [:symbols :main :nodes :s :channels paint/geometry :keys])]
+    (is (= #{0 5 10} (set (keys ks))))
+    (is (= square (ks 0) (ks 10)))))

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,64 @@
     (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)))))
+
+(deftest a-remap-shape-lights-what-is-under-it-and-nothing-else
+  ;; A flashlight: a circle that draws nothing of its own, and draws what is
+  ;; already under it in other slots of the palette.
+  (let [sq (fn [x0 y0 x1 y1] [x0 y0 x1 y0 x1 y1 x0 y1])
+        document (-> (clip/blank)
+                     (paint/new-shape :main :wall 0 (sq 0 0 40 20) 2)
+                     (paint/new-shape :main :door 0 (sq 10 0 20 20) 3)
+                     (paint/new-shape :main :beam 0 (sq 5 5 15 15) [:remap {2 5}])
+                     (assoc-in [:symbols :main :nodes :wall :z] "a")
+                     (assoc-in [:symbols :main :nodes :door :z] "b")
+                     (assoc-in [:symbols :main :nodes :beam :z] "c"))
+        context (pal/compile document)
+        ops (vec ((clip/resolver document :main nil context nil) 0))
+        ras (raster/draw-ops! (raster/clear! (raster/make 320 200) 0) ops)
+        at  (fn [x y] (aget (:buf ras) (+ x (* y 320))))
+        slot #(pal/render-index context (pal/default-palette-id document) %)]
+    (is (= (slot 5) (at 7 10)) "the wall under the beam is lit")
+    (is (= (slot 3) (at 12 10)) "the door under it is a slot the map leaves alone")
+    (is (= (slot 2) (at 30 10)) "and the wall outside it is as it was")
+    (is (= [:wall] (pick/hit ops [7 10])) "a click goes through the light")))

frontend/test/arthur/domain/outline_test.cljs

@@ -0,0 +1,98 @@
+(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 a-fit-keeps-the-corners-and-straightens-the-stairs
+  (let [block  (let [m (outline/mask 60 60)]
+                 (doseq [y (range 10 40) x (range 10 50)] (aset (:buf m) (+ x (* y 60)) 1))
+                 (first (outline/rings m)))
+        stairs (let [m (outline/mask 60 60)]
+                 (doseq [y (range 5 55) x (range 5 (inc y))] (aset (:buf m) (+ x (* y 60)) 1))
+                 (first (outline/rings m)))]
+    (is (= 8 (count (outline/fit block 1))) "a rectangle is its four corners")
+    (is (= 6 (count (outline/fit stairs 1))) "a pixel staircase is one diagonal: a triangle")
+    (is (< 6 (count (outline/fit stairs 0.25))) "unless asked to fit closer than the steps")))
+
+(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 overlapping-strokes-leave-no-slivers-and-nothing-crosses
+  ;; A scribble back and forth over itself: the gaps between passes are not
+  ;; holes anyone meant, and the one ring it makes fills back to the scribble
+  ;; without a cut through it.
+  (let [m (reduce (fn [m i] (outline/stamp! m [10 (+ 10 (* 3 i))] [70 (+ 12 (* 3 i))] 5))
+                  (outline/mask 80 60) (range 10))
+        [piece] (outline/pieces m)
+        ring (outline/polygon piece 1)
+        back (:buf (r/fill-poly-buf! (r/make 80 60) ring (quot (count ring) 2) 1))
+        miss (count (filter true? (map not= (array-seq (:buf m)) (array-seq back))))]
+    (is (< miss 80) (str miss " pixels differ — within a pixel of the edge, not a cut"))
+    (is (every? #(< (count %) 40) (outline/rings-of piece 1)) "and every ring is simple")))
+
+(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)))))))
+
+(deftest a-small-hole-is-a-few-points-not-its-staircase
+  (let [m (outline/mask 60 60)]
+    (doseq [y (range 10 50) x (range 10 50)
+            :when (not (and (< 25 x 34) (< 25 y 34)))]
+      (aset (:buf m) (+ x (* y 60)) 1))
+    (let [[outer hole] (outline/rings-of (first (outline/pieces m)) 1)]
+      (is (= 8 (count outer)))
+      (is (= 8 (count hole)) "an 8×8 hole is its four corners"))))
+
+(deftest a-hole-whose-fit-would-cross-the-outside-is-clipped-to-it
+  ;; A wedge-shaped gap reaching to within a pixel of the outside: fitted on its
+  ;; own, its edge can cross the outside's. It stays a hole, inside the body.
+  (let [m (outline/mask 60 60)]
+    (doseq [y (range 10 50) x (range 10 50)
+            :when (not (and (< 12 x 47) (< 12 y (- 47 (quot (- x 12) 3)))))]
+      (aset (:buf m) (+ x (* y 60)) 1))
+    (let [rs (outline/rings-of (first (outline/pieces m)) 3)
+          ring (outline/join rs)
+          back (:buf (r/fill-poly-buf! (r/make 60 60) ring (quot (count ring) 2) 1))]
+      (is (< 1 (count rs)) "the hole is kept")
+      (is (zero? (aget back (+ 25 (* 20 60)))) "and is a hole")
+      (is (every? #(< (count %) 30) rs) "and simple")
+      (is (zero? (aget back (+ 5 (* 5 60)))) "and nothing outside the body is filled"))))

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. */
 .tracing { 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. */
@@ -1422,6 +1420,7 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
    rotates with the node and the tag does not. Sizes are in user units because
    this SVG's viewBox is the stage's 320x200 scaled by `zoom`. */
 .paint-overlay .creation-target { pointer-events: none; }
+.paint-overlay .selected-paint-outline { fill: none; stroke: #fbbf24; stroke-width: 0.8; vector-effect: non-scaling-stroke; pointer-events: none; }
 .paint-overlay .creation-target .creation-target-box { fill: none; stroke: var(--target-stage); stroke-width: 0.7; }
 .paint-overlay .creation-target .creation-target-tag-bg { fill: var(--target-stage); }
 .paint-overlay .creation-target .creation-target-tag {
@@ -1532,8 +1531,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 —
@@ -1542,17 +1541,175 @@ 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);
+}
+
+/* Remap: the map swatch, and the inspector's grid for a remap shape. A slot is
+   shown as what is under the shape will be drawn in; the original is the chip
+   in its corner. */
+.palette .cell.map,
+.palette .chip.map {
+  background: linear-gradient(135deg, #3a3f52 0 50%, #e8d9a8 50% 100%);
+  color: #fff; font-size: 11px; line-height: 1; text-shadow: 0 1px 1px rgba(0, 0, 0, .6);
+}
+.palette .cell.map { grid-column: span 2; width: 36px; }
+.palette .cell { position: relative; }
+.palette .cell .badge {
+  position: absolute; right: -2px; bottom: -2px;
+  width: 7px; height: 7px;
+  border: 1px solid var(--pane); border-radius: 50%;
+}
+
+.remap-head { display: flex; align-items: center; gap: 6px; margin-bottom: 6px; }
+.remap, .remap-pick { display: grid; grid-template-columns: repeat(8, 22px); gap: 3px; }
+.remap-pick { margin-top: 7px; padding-top: 7px; border-top: 1px solid var(--hair); }
+.remap-pick > .dim { grid-column: 1 / -1; }
+.remap .cell, .remap-pick .cell {
+  position: relative;
+  width: 22px; height: 22px;
+  padding: 0;
+  border: 1px solid rgba(0, 0, 0, .35);
+  border-radius: 3px;
+  cursor: pointer;
+}
+.remap .cell:hover, .remap-pick .cell:hover { border-color: var(--fg); }
+.remap .cell.on, .remap-pick .cell.on { box-shadow: 0 0 0 1px var(--pane), 0 0 0 2px var(--sel); }
+.remap .cell.mapped i {
+  position: absolute; left: 2px; top: 2px;
+  width: 8px; height: 8px;
+  border: 1px solid rgba(255, 255, 255, .8);
+  border-radius: 2px;
 }