diff --git a/frontend/package-lock.json b/frontend/package-lock.json index a4c5be8..901ccc3 100644 --- a/frontend/package-lock.json +++ b/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", diff --git a/frontend/package.json b/frontend/package.json index 8cb1e39..fe89f12 100644 --- a/frontend/package.json +++ b/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" }, diff --git a/frontend/src/arthur/domain/clip.cljs b/frontend/src/arthur/domain/clip.cljs index 1833805..cfa5a4d 100644 --- a/frontend/src/arthur/domain/clip.cljs +++ b/frontend/src/arthur/domain/clip.cljs @@ -434,8 +434,10 @@ (placed-frame clip sid n local)) frame (:frame shown)] (if (and frame (<= 0 frame) (< frame length)) - (do (vswap! entered assoc id (:symbol shown)) - (map #(transform-op % m [id]) + (let [override (when (and context? (:palette n)) + (selection-at n frame nil))] + (vswap! entered assoc id (:symbol shown)) + (map #(transform-op % m [id]) ((get children [id (:symbol shown)]) frame ;; The slot's interval crosses the @@ -452,8 +454,7 @@ (placed-frame clip sid n prior))) (dec frame)) @active - (when (and context? (:palette n)) - (selection-at n frame nil))))) + override))) [])) (when-let [op (get by-id id)] [op])))) ids)) diff --git a/frontend/src/arthur/domain/cut.cljs b/frontend/src/arthur/domain/cut.cljs new file mode 100644 index 0000000..e2f2382 --- /dev/null +++ b/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))) diff --git a/frontend/src/arthur/domain/outline.cljs b/frontend/src/arthur/domain/outline.cljs index 9a7ad96..0aa6790 100644 --- a/frontend/src/arthur/domain/outline.cljs +++ b/frontend/src/arthur/domain/outline.cljs @@ -20,10 +20,15 @@ one. It is how earcut and the TrueType rasterisers take holes too. `pieces` keeps the trace — outside and holes, at full resolution — so the - count of points can change after the stroke, and `polygon` is the one place - it is simplified and bridged: the preview and the saved shape are the same - function's output, so what is on screen while painting is what is kept." - (:require [arthur.domain.raster :as raster])) + 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))}) @@ -149,51 +154,14 @@ ([m] (rings m 2)) ([m smallest] (mapv :outer (pieces m smallest)))) -(defn simplify - "Ring `pts` cut down to `n` points, a closed ring of at least three: - Visvalingam's, which takes away whichever point makes the smallest triangle - with its neighbours until `n` are left — so the corners that carry the shape - are the last to go, and the count is exactly the one asked for. - - Over typed arrays and a linked ring, because it runs on every pointer move of - a brush stroke: taking a point away changes only its two neighbours' areas." - [pts n] - (let [c (quot (count pts) 2) - n (max 3 n)] - (if (<= c n) - (vec pts) - (let [xs (js/Float64Array. c) ys (js/Float64Array. c) - prev (js/Int32Array. c) next (js/Int32Array. c) - area (js/Float64Array. c) - live (js/Uint8Array. c) - best (js/Int32Array. 1) - tri! (fn [k] - (let [a (aget prev k) d (aget next k)] - (aset area k (js/Math.abs (- (* (- (aget xs k) (aget xs a)) (- (aget ys d) (aget ys a))) - (* (- (aget xs d) (aget xs a)) (- (aget ys k) (aget ys a))))))))] - (dotimes [k c] - (aset xs k (nth pts (* 2 k))) (aset ys k (nth pts (inc (* 2 k)))) - (aset prev k (mod (dec k) c)) (aset next k (mod (inc k) c)) - (aset live k 1)) - (dotimes [k c] (tri! k)) - (dotimes [_ (- c n)] - (let [_ (aset best 0 -1) - _ (dotimes [k c] - (when (and (== 1 (aget live k)) - (or (neg? (aget best 0)) (< (aget area k) (aget area (aget best 0))))) - (aset best 0 k))) - k (aget best 0) - a (aget prev k) d (aget next k)] - (aset live k 0) - (aset next a d) (aset prev d a) - (tri! a) (tri! d))) - (into [] (mapcat (fn [k] (when (== 1 (aget live k)) [(aget xs k) (aget ys k)]))) (range c)))))) - -(defn- perimeter [pts] +(defn- area + "The area inside ring `pts`, by the shoelace." + [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))))) + (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, @@ -224,12 +192,102 @@ (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 one ring, with a point about every `spacing` pixels - of its outline — so a long stroke gets more points than a dab, and a hole gets - its own share — and the holes bridged in." - [{:keys [outer holes]} spacing] - (let [share #(max 3 (js/Math.round (/ (perimeter %) (max 0.01 spacing))))] - (reduce bridge (simplify outer (share outer)) - (sort-by #(apply min (take-nth 2 %)) - (map #(simplify % (share %)) holes))))) + "Piece `p` of `pieces` as the one ring a shape is made of. See `rings-of`." + [p tol] + (join (rings-of p tol))) diff --git a/frontend/src/arthur/domain/pick.cljs b/frontend/src/arthur/domain/pick.cljs index 44c3784..e0c1156 100644 --- a/frontend/src/arthur/domain/pick.cljs +++ b/frontend/src/arthur/domain/pick.cljs @@ -49,9 +49,10 @@ (and (<= (js/Math.abs (- x cx)) h) (<= (js/Math.abs (- y cy)) h))) false)) -(defn- op-bounds [{:keys [kind pts n cx cy r size knock]}] - ;; A knockout draws nothing, so a marquee does not catch it. - (case (when-not knock kind) +(defn- op-bounds [{:keys [kind pts n cx cy r size knock lut]}] + ;; A knockout or a remap draws nothing of its own, so a marquee does not + ;; catch it. + (case (when-not (or knock lut) kind) :poly (reduce (fn [b i] (let [x (aget pts (* 2 i)) y (aget pts (inc (* 2 i)))] (if b (let [[x0 y0 x1 y1] b] @@ -86,7 +87,8 @@ [ops [x y]] (:op (reduce (fn [holes op] (cond - (not (on? op x y)) holes + ;; 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))))) diff --git a/frontend/src/arthur/domain/raster.cljs b/frontend/src/arthur/domain/raster.cljs index 5f06266..79fac57 100644 --- a/frontend/src/arthur/domain/raster.cljs +++ b/frontend/src/arthur/domain/raster.cljs @@ -34,15 +34,22 @@ ;; only where it is covered. The main raster has no `:cov` and is always ;; covered. ;; -;; `knock` is nil for an ordinary fill, -1 for a knockout of every colour, and -;; an index for a knockout of that colour only. +;; 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 knock] - (if (nil? knock) - (do (aset buf o index) - (when cov (aset cov o 1))) - (when (and cov (or (neg? knock) (== (aget buf o) knock))) - (aset cov o 0)))) +(defn- 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 @@ -75,9 +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. `knock` is as `plot!`'s." + into a plain JS array and sorted in place. `ink` is as `plot!`'s." ([r pts n index] (fill-poly-buf! r pts n index nil)) - ([{:keys [w h buf cov] :as r} pts n index knock] + ([{: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))))) @@ -119,7 +126,7 @@ x-to (min (dec w) (js/Math.floor (- xb 0.5))) row (* y w)] (dotimes [dx (inc (- x-to x-from))] - (plot! buf cov (+ row x-from dx) index knock))))))))) + (plot! buf cov (+ row x-from dx) index ink))))))))) r)) (defn fill-poly! @@ -142,7 +149,7 @@ clamp that would flatten the performance at the extremes." ([r cx cy rad index] (fill-disc! r cx cy rad index nil nil)) ([r cx cy rad index over] (fill-disc! r cx cy rad index over nil)) - ([{:keys [w h buf cov] :as r} cx cy rad index over knock] + ([{: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))) @@ -157,7 +164,7 @@ (when (<= (+ (* dx dx) (* dy dy)) rr) (let [o (+ (* y w) x)] (when (shows? buf cov o over) - (plot! buf cov o index knock))))))) + (plot! buf cov o index ink))))))) r))) (defn fill-rect! @@ -176,7 +183,7 @@ breathing." ([r cx cy size index] (fill-rect! r cx cy size index nil nil)) ([r cx cy size index over] (fill-rect! r cx cy size index over nil)) - ([{:keys [w h buf cov] :as r} cx cy size index over knock] + ([{: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))) @@ -187,7 +194,7 @@ (dotimes [ix (- xb xa)] (let [o (+ (* (+ ya iy) w) xa ix)] (when (shows? buf cov o over) - (plot! buf cov o index knock)))))))) + (plot! buf cov o index ink)))))))) r)) (def ^:private little-endian? @@ -269,10 +276,10 @@ (defn- fill-mask! "Every pixel set in `mask`, a byte per stage pixel: a brush stroke as it is being painted, before it is a polygon." - [{:keys [buf cov] :as r} ^js mask index knock] + [{:keys [buf cov] :as r} ^js mask index ink] (dotimes [o (.-length mask)] (when (== 1 (aget mask o)) - (plot! buf cov o index knock))) + (plot! buf cov o index ink))) r) ;; One layer per depth of nesting, reused from frame to frame, as the resolver @@ -297,11 +304,12 @@ here indistinguishable from each other, which is the point. `:begin` and `:end` bracket the ops of a symbol drawn into a layer of its own; - `:knock` on an op makes it a knockout. See `plot!`." + `:knock` on an op makes it a knockout and `:lut` a remap. See `plot!`." [{:keys [w h] :as r} ops] (reduce - (fn [stack {:keys [kind pts n color stencil cx cy size knock] :as op}] - (let [top (peek stack)] + (fn [stack {:keys [kind pts n color stencil cx cy size] :as op}] + (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) @@ -309,10 +317,10 @@ :end (if (< 1 (count stack)) (let [s (pop stack)] (composite! (peek s) top) s) stack) - :poly (do (fill-poly-buf! top pts n color knock) stack) - :disc (do (fill-disc! top cx cy (:r op) color stencil knock) stack) - :rect (do (fill-rect! top cx cy size color stencil knock) stack) - :mask (do (fill-mask! top (:mask op) color knock) stack) + :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) diff --git a/frontend/src/arthur/domain/symbol.cljs b/frontend/src/arthur/domain/symbol.cljs index 42cb7f3..206f7b9 100644 --- a/frontend/src/arthur/domain/symbol.cljs +++ b/frontend/src/arthur/domain/symbol.cljs @@ -287,9 +287,25 @@ [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." @@ -424,9 +440,10 @@ ;; `[:style :color]` to read. (let [paint (fn [op] (let [c (rd [:style :color])] - (if (knockout? c) - (assoc op :knock (knock-index palette c) :color 0) - (assoc op :color (colour-index palette c)))))] + (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 diff --git a/frontend/src/arthur/events/ui.cljs b/frontend/src/arthur/events/ui.cljs index 2ae5a0c..00e2b46 100644 --- a/frontend/src/arthur/events/ui.cljs +++ b/frontend/src/arthur/events/ui.cljs @@ -20,6 +20,7 @@ [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] @@ -699,61 +700,79 @@ ;; brush and eraser ;; ;; A stroke arrives as the pieces `domain/outline` traced off its mask, in stage -;; pixels, holes and all. Each becomes a shape with a point every `:spacing` -;; pixels of its outline — so a long stroke gets more than a dab. What it was -;; made from is kept in `[:ui :last]`, Blender's Adjust Last Operation, so the -;; spacing can be changed afterwards from the trace rather than from the points -;; already thrown away, until something else is done. +;; 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-spacing 6) +(def default-fit 1) -(defn- stroke-points [pieces spacing] - (mapv #(outline/polygon % spacing) pieces)) +(defn- stroke-points [pieces fit] + (mapv #(outline/polygon % fit) pieces)) (rf/reg-event-db - ::spacing - (fn [db [_ spacing]] (assoc-in db [:ui :spacing] (-> spacing (max 1) (min 40))))) + ::fit + (fn [db [_ fit]] (assoc-in db [:ui :fit] (-> fit (max 0.5) (min 8))))) + +(defn- saved [db] (:clip (store/entry (:clip/current db)))) + +(defn- fresh-ids [] (repeatedly #(keyword (str "paint-" (random-uuid))))) + +(defn- erasing + "`db` with `pieces` cut out of the shapes at `paths`. See `cut/erase`." + [db before pieces fit paths ids] + (let [{st :store} (store/entry (:clip/current db)) + cutters (mapv #(outline/rings-of % fit) pieces)] + (edit/transaction db (fn [_] (cut/erase before st (get-in db [:ui :open]) + (editing-frame db before) paths cutters ids))))) (rf/reg-event-db ::stroke - ;; `down` and `colour` are the eraser's: the symbol the stroke began in, and - ;; the knockout it makes there. The brush draws in the tone, into the creation - ;; target, as the pen does. - (fn [db [_ {:keys [pieces down colour]}]] - (let [spacing (get-in db [:ui :spacing] default-spacing) - {:keys [refused clip sid frame] :as at} (when (seq pieces) - (landing-into db down (stroke-points pieces spacing))) - ids (vec (repeatedly (count pieces) #(keyword (str "paint-" (random-uuid)))))] - (cond - (empty? pieces) db - refused (update db :project merge {:status refused}) - :else - (cond-> (-> db - (edit/transaction - (fn [_] (reduce (fn [c [id pts]] - (paint/new-shape c sid id frame pts - (or colour (get-in db [:ui :tone])))) - clip (map vector ids (:rings at))))) - (assoc-in [:ui :last] {:kind (if down :eraser :brush) :pieces pieces - :spacing spacing - :down (:down at) :sid sid :frame frame :ids ids})) - (nil? down) (selected [:node sid (peek ids) (conj (:down at) (peek ids))])))))) + ;; The brush draws in the tone, into the creation target, as the pen does. + ;; With `paths` it is the eraser's, and cuts the shapes they lead to. + (fn [db [_ {:keys [pieces paths]}]] + (let [fit (get-in db [:ui :fit] default-fit) + before (saved db)] + (if paths + (let [ids (vec (take 64 (fresh-ids))) + db (erasing db before pieces fit paths ids)] + (assoc-in db [:ui :last] {:kind :eraser :pieces pieces :paths paths :ids ids + :fit fit :before before :after (saved db)})) + (let [{:keys [refused clip sid frame] :as at} (when (seq pieces) + (landing-into db nil (stroke-points pieces fit))) + ids (vec (take (count pieces) (fresh-ids)))] + (cond + (empty? pieces) db + refused (update db :project merge {:status refused}) + :else + (let [db (-> db + (edit/transaction + (fn [_] (reduce (fn [c [id pts]] + (paint/new-shape c sid id frame pts (get-in db [:ui :tone]))) + clip (map vector ids (:rings at))))) + (selected [:node sid (peek ids) (conj (:down at) (peek ids))]))] + (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 spacing, and the next one's: one setting, in the options + ;; 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 [_ spacing]] - (let [{:keys [pieces down sid frame ids]} (get-in db [:ui :last]) - at (when pieces (landing-into db down (stroke-points pieces spacing)))] - (if (and pieces (= sid (:sid at))) - (-> db - (assoc-in [:ui :spacing] spacing) - (assoc-in [:ui :last :spacing] spacing) - (edit/transaction - (fn [c] (reduce (fn [c [id pts]] (paint/set-points c sid id frame pts)) - c (map vector ids (:rings at)))))) - db)))) + (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 diff --git a/frontend/src/arthur/subs/ui.cljs b/frontend/src/arthur/subs/ui.cljs index 9a7d9a8..9e457ee 100644 --- a/frontend/src/arthur/subs/ui.cljs +++ b/frontend/src/arthur/subs/ui.cljs @@ -34,7 +34,7 @@ (rf/reg-sub ::draft (fn [db _] (get-in db [:ui :draft]))) (rf/reg-sub ::hover (fn [db _] (get-in db [:ui :hover]))) (rf/reg-sub ::brush (fn [db _] (get-in db [:ui :brush] 6))) -(rf/reg-sub ::spacing (fn [db _] (get-in db [:ui :spacing] 6))) +(rf/reg-sub ::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]))) @@ -46,11 +46,12 @@ (rf/reg-sub ::last :<- [::last-op] - :<- [::render/clip] - ;; The last stroke, while what it made is still there to adjust: an undo takes - ;; the panel away with the shapes. - (fn [[{:keys [sid ids] :as op} clip] _] - (when (and op (get-in clip [:symbols sid :nodes (first ids)])) op))) + :<- [::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 diff --git a/frontend/src/arthur/ui/palette.cljs b/frontend/src/arthur/ui/palette.cljs index aa44656..528b161 100644 --- a/frontend/src/arthur/ui/palette.cljs +++ b/frontend/src/arthur/ui/palette.cljs @@ -14,13 +14,16 @@ 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. See `ui/params`." - (:require [arthur.domain.node :as node] + (:require [arthur.domain.channel :as channel] + [arthur.domain.node :as node] [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] - [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]))) @@ -45,17 +48,101 @@ (when (seq edits) (rf/dispatch [::project/set-channels edits])))) -(defn- swatch [pid i {:keys [name hex]} tone placements] - (let [picker-id (str "palette-picker-" pid "-" i)] +;; --------------------------------------------------------------------------- +;; 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 "slot " i (when name (str " · " (clojure.core/name name))) - " · " hex " — double-click to edit") + " · " hex + (when to (str " · lit as " to " under the selected remap")) + " — double-click to edit" + (when rm ", drag onto another to remap it under the selected remap")) + :draggable (some? rm) + :on-drag-start #(.setData (.-dataTransfer %) "application/x-arthur-slot" (str i)) + :on-drag-over (fn [^js e] (when rm (.preventDefault e))) + :on-drop (fn [^js e] + (.preventDefault e) + (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)])}]])) @@ -68,18 +155,24 @@ placements @(rf/subscribe [::sub/selected-placements]) hex (when (number? tone) (:hex (get (:slots palette) tone)))] [:div.palette - [:div {:class (str "chip" (when (= :clear tone) " clear")) + [:div {:class (str "chip" (cond (= :clear tone) " clear" (symbol/remap? tone) " map")) :style (when hex {:background hex}) - :title (if (= :clear tone) - "clear: what is drawn knocks out what is under it in its symbol" - (str "slot " tone " · " hex))} - [:span (if (= :clear tone) "×" tone)]] + :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 - (doall (map-indexed #(swatch pid %1 %2 tone placements) (:slots palette))) + (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)}]]]])) + :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 diff --git a/frontend/src/arthur/ui/params.cljs b/frontend/src/arthur/ui/params.cljs index 60f5140..ea380ad 100644 --- a/frontend/src/arthur/ui/params.cljs +++ b/frontend/src/arthur/ui/params.cljs @@ -24,6 +24,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])) @@ -210,10 +211,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) - value - (or (first (keep-indexed #(when (= value (:name %2)) %1) - (:slots palette))) 0)) + ;; A knockout or a remap is no slot, and none is marked. + value (cond + (integer? value) value + (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") @@ -826,6 +828,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]) diff --git a/frontend/src/arthur/ui/player.cljs b/frontend/src/arthur/ui/player.cljs index 2ba113d..3115927 100644 --- a/frontend/src/arthur/ui/player.cljs +++ b/frontend/src/arthur/ui/player.cljs @@ -20,10 +20,12 @@ 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] @@ -114,7 +116,7 @@ pen {:draft @(rf/subscribe [::ui-sub/draft]) :hover @(rf/subscribe [::ui-sub/hover]) :tone @(rf/subscribe [::ui-sub/tone]) - :spacing @(rf/subscribe [::ui-sub/spacing]) + :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]))}] @@ -147,7 +149,7 @@ ;; The brush or eraser stroke being painted: its mask, mutated in place as the ;; pointer moves, which is why it is an atom the stage pokes rather than state -;; anything renders from. `{:mask :version :slot :knock :target}`, `:mask` being an +;; anything renders from. `{:mask :version :slot :knock :paths}`, `:mask` being an ;; `outline/mask`. (defonce ^:private stroke (atom nil)) (defonce ^:private trace-cache (atom nil)) @@ -195,39 +197,67 @@ slot)) (defn- traced - "Stroke `s` as the polygons letting go would make of it: traced and - simplified by the same function the saved shapes are, so the preview IS them. - Once per version of the mask and spacing, not once per paint." - [{:keys [mask version]} spacing] - (let [key [mask version spacing]] + "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)) - (:polys @trace-cache) - (:polys (reset! trace-cache + (:rings @trace-cache) + (:rings (reset! trace-cache {:key key - :polys (mapv #(outline/polygon % spacing) (outline/pieces mask))}))))) + :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, and a stroke as the polygons it will be. A knockout goes INTO that - symbol's layer, so it clears what the saved one will and nothing else." + 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 spacing target]} (:pen @snapshot) + (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] :as s} @stroke - poly (fn [ring op] (assoc op :kind :poly :pts (into-array ring) :n (quot (count ring) 2)))] + {:keys [slot knock paths] :as s} @stroke + rings (when (:mask s) (traced s fit))] (cond-> ops - (and (<= 6 (count pts)) (number? tone)) - (clip/atop target (poly pts {:color (index-of-slot palette active tone)})) + (and (<= 6 (count pts)) (or (number? tone) (symbol/remap? tone))) + (clip/atop target (inked (poly pts {}) tone palette active)) - (and (:mask s) (nil? knock)) - (as-> ops (reduce #(clip/atop %1 target (poly %2 {:color (index-of-slot palette active slot)})) - ops (traced s spacing))) + paths + (cut-ops paths rings) - (and (:mask s) knock) - (as-> ops (reduce #(clip/in-layer %1 (or (:target s) target) (poly %2 {:color 0 :knock knock})) - ops (traced s spacing)))))) + (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 — diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs index 7782243..621af19 100644 --- a/frontend/src/arthur/ui/stage.cljs +++ b/frontend/src/arthur/ui/stage.cljs @@ -17,6 +17,7 @@ [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] @@ -379,13 +380,15 @@ "`[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)] + (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) + (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)))) @@ -393,28 +396,36 @@ (defn- stroke-begin! "Start painting with the brush, or erasing, at stage point `p`. - The eraser's target is the symbol holding what the stroke STARTS on, and it - clears that colour only — Photoshop's background eraser — or, with ⌥, every - colour. Starting on nothing with ⌥ erases in the open symbol." + 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]))) - all? (.-altKey event) + within (if path (pop path) []) {document :clip st :store} (loaded ctx) - slot (when path - (when-let [{:keys [sid id frame]} (nest/placement document st open path f)] - (channel/value-at (get-in document [:symbols sid :nodes id :channels [:style :color]]) - frame st))) + 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: nil here. - (not eraser?) - {:mask m :slot tone :knock (when (= :clear tone) -1)} - (or all? path) - {:mask m :knock (if all? -1 (:color op)) :target (if path (pop path) []) - :down (if path (pop path) []) :colour (if all? :clear [:clear slot])})] + ;; 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))) @@ -428,11 +439,11 @@ (player/stroke! (swap! painting #(-> % (assoc :last p) (update :version inc)))))) (defn- stroke-end! [] - (when-let [{:keys [mask down colour]} @painting] + (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) :down down :colour colour}]) + (rf/dispatch-sync [::ui/stroke {:pieces (outline/pieces mask) :paths paths}]) (player/stroke! nil))) (defn- cursor @@ -442,6 +453,17 @@ (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." @@ -452,7 +474,7 @@ (on-edge pts @pointer))] (when (and pts (not (channel/nothing? pts))) [:g.points - [:polygon.outline {:points (points-text pts)}] + [: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}])) @@ -501,7 +523,11 @@ pen? (= :pen tool) ;; The shape the pen is on, read while rendering: a click handler is ;; not a reactive context to subscribe from. - [esid eid egeom _ editable? eframe matrix] (when pen? (editing)) + [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 tool-" (name tool) @@ -594,6 +620,9 @@ (reset! painting nil) (player/stroke! nil) (let-go! false))} [ghost] + (when (seq selected-pts) + [:polygon.selected-paint-outline + {: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) diff --git a/frontend/src/arthur/ui/tools.cljs b/frontend/src/arthur/ui/tools.cljs index b909323..6d11766 100644 --- a/frontend/src/arthur/ui/tools.cljs +++ b/frontend/src/arthur/ui/tools.cljs @@ -27,7 +27,7 @@ :icon [:<> [:path {:d "M15 1.5 L16.5 3 L9 10.5 L7.5 9 Z"}] [:path {:d "M6.5 10 C4 10 3 11.5 3 13.5 C3 15 1.5 16 1.5 16 C5 16 8 15 8 11.5 Z"}]]} {:tool :eraser :key "e" :name "Eraser" - :tip "erases the colour you start on, in its symbol · ⌥ erases every colour" + :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"}]]}]) @@ -51,13 +51,16 @@ :on-change #(rf/dispatch [::ui/brush-size (js/parseInt (.. % -target -value))])}] [:span.value (str size "px")]])) -(defn- spacing-control - "A point every so many pixels of outline: the brush's detail, by length." - [spacing event] - [:label.option {:title "fewer pixels between points is more detail"} "a point every" - [:input {:type "range" :min 1 :max 40 :value spacing - :on-change #(rf/dispatch [event (js/parseInt (.. % -target -value))])}] - [:span.value (str spacing "px")]]) +(defn- 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]) @@ -75,7 +78,7 @@ [:button {:on-click #(rf/dispatch [::ui/cancel-polygon])} "discard"]] [:span.dim.hint tip]) (:brush :eraser) [:<> [size-control] - [spacing-control @(rf/subscribe [::sub/spacing]) ::ui/spacing] + [fit-control @(rf/subscribe [::sub/fit]) ::ui/fit] [:span.dim.hint tip]] (if (< 1 (count selections)) [:span.dim (str (count selections) " selected")] @@ -87,14 +90,14 @@ [layout/zoomer :stage "the stage"]])) (defn adjust-last - "Blender's Adjust Last Operation, for a brush or eraser stroke: its spacing, + "Blender's Adjust Last Operation, for a brush or eraser stroke: its fit, changeable until something else is done." [] - (when-let [{:keys [kind ids spacing]} @(rf/subscribe [::sub/last])] + (when-let [{:keys [kind ids fit]} @(rf/subscribe [::sub/last])] [:div.adjust-last [:strong (if (= :eraser kind) "Erase" "Brush stroke")] - (when (< 1 (count ids)) [:span.dim (str (count ids) " pieces")]) - [spacing-control spacing ::ui/adjust-last]])) + (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 diff --git a/frontend/test/arthur/domain/cut_test.cljs b/frontend/test/arthur/domain/cut_test.cljs new file mode 100644 index 0000000..ac4d74e --- /dev/null +++ b/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))))) diff --git a/frontend/test/arthur/domain/instance_test.cljs b/frontend/test/arthur/domain/instance_test.cljs index 600086c..32b2f68 100644 --- a/frontend/test/arthur/domain/instance_test.cljs +++ b/frontend/test/arthur/domain/instance_test.cljs @@ -522,3 +522,24 @@ (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"))) diff --git a/frontend/test/arthur/domain/outline_test.cljs b/frontend/test/arthur/domain/outline_test.cljs index d8df7d1..2ad2a0a 100644 --- a/frontend/test/arthur/domain/outline_test.cljs +++ b/frontend/test/arthur/domain/outline_test.cljs @@ -25,11 +25,16 @@ (is (< 8 (covered m))) (is (< 15 (apply min (take-nth 2 (first (outline/rings m))))) "the long one first"))) -(deftest simplify-keeps-exactly-the-count-asked-for - (let [ring (first (outline/rings (outline/stamp! (outline/mask 60 60) [30 30] [30 30] 40)))] - (is (= 24 (count (outline/simplify ring 12)))) - (is (= 6 (count (outline/simplify ring 1))) "never fewer than three points") - (is (= ring (outline/simplify ring 10000))))) +(deftest a-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 @@ -48,11 +53,18 @@ (is (zero? (aget (fill (outline/polygon piece 0.01)) middle)) "the middle is a hole") (is (zero? (aget (fill (outline/polygon piece 8)) middle)) "and simplified, still a hole"))) -(deftest points-go-by-length - (let [dab (first (outline/pieces (outline/stamp! (outline/mask 80 40) [10 20] [10 20] 8))) - long (first (outline/pieces (outline/stamp! (outline/mask 80 40) [10 20] [70 20] 8)))] - (is (< (count (outline/polygon dab 6)) (count (outline/polygon long 6)))) - (is (= 6 (count (outline/polygon dab 1000))) "never fewer than three"))) +(deftest 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) @@ -60,3 +72,27 @@ (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")))) diff --git a/static/arthur/app.css b/static/arthur/app.css index 43dd86a..6f8c26a 100644 --- a/static/arthur/app.css +++ b/static/arthur/app.css @@ -1414,6 +1414,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 { @@ -1669,3 +1670,40 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); } 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; +}