Move palette controls to sidebar and expand stage navigation

This commit is contained in:
Olive Vaughn 2026-10-04 00:40:20 -04:00
parent 1ae49a4015
commit 484b4f1698
9 changed files with 175 additions and 49 deletions

View file

@ -36,7 +36,9 @@
"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))
(let [[ox oy] (or (:origin m) [0 0])
ax (- ax ox) ay (- ay oy) bx (- bx ox) by (- by oy)
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)]
@ -115,11 +117,11 @@
[(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
(defn- buffer-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))
([m] (buffer-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))
@ -148,6 +150,14 @@
{:outer (ring w (in id) start)
:holes (mapv #(ring w (in (:id %)) (:start %)) (get holes id))})))))))
(defn pieces
([m] (pieces m 2))
([m smallest]
(let [[ox oy] (or (:origin m) [0 0])
shift (fn [ring] (mapv (fn [i v] (+ v (if (even? i) ox oy))) (range) ring))]
(mapv (fn [p] (-> p (update :outer shift) (update :holes #(mapv shift %))))
(buffer-pieces m smallest)))))
(defn rings
"The outside of every piece of the mask, as flat corner points, biggest
first."

View file

@ -43,7 +43,7 @@
"[lo hi] per key — pixels for a pane, a multiplier for a zoom. The low end of
`:time` is the transport strip plus a row, so dragging the timeline shut and
shutting it are the same shape of window."
{:pool [120 480] :params [150 560] :time [44 660] :stage [1 8] :tl [1 24]})
{:pool [120 480] :params [150 560] :time [44 660] :stage [0.1 16] :tl [1 24]})
(defn- clamp [k v]
(let [[lo hi] (limits k)] (max lo (min hi v))))
@ -136,12 +136,9 @@
label])))]))
(defn- stepped [k z out?]
;; The stage steps by WHOLE pixels. A fractional scale under
;; `image-rendering: pixelated` draws some rows of the raster thicker than
;; others, which misrepresents the one thing the preview exists to judge. The
;; timeline has no pixel grid to honour, so it steps geometrically.
;; Geometric steps work below 100% as well as above it.
(if (= :stage k)
(+ z (if out? -1 1))
(* z (if out? (/ 1 1.25) 1.25))
(* z (if out? (/ 1 1.5) 1.5))))
(defn zoomer
@ -165,3 +162,32 @@
[:button {:disabled (>= z hi) :aria-label (str label " zoom in")
:title (str "zoom " label " in")
:on-click #(rf/dispatch [::set k (stepped k z false)])} "+"]]))
(rf/reg-sub ::mat (fn [db _] (merge {:margin 100 :opacity 0.55} (get-in db [:ui :passepartout]))))
(rf/reg-event-db ::mat (fn [db [_ k v]] (assoc-in db [:ui :passepartout k] v)))
(defn fit-stage! []
(when-let [area (.querySelector js/document ".stage-area")]
(when-let [wrap (.querySelector area ".stage-wrap")]
(let [w (js/parseFloat (.getAttribute wrap "data-width"))
h (js/parseFloat (.getAttribute wrap "data-height"))]
(rf/dispatch-sync [::set :stage (min (/ (- (.-clientWidth area) 32) w)
(/ (- (.-clientHeight area) 32) h))])
(js/requestAnimationFrame #(do (set! (.-scrollLeft area) 0) (set! (.-scrollTop area) 0)))))))
(defn stage-controls []
(let [{:keys [margin opacity]} @(rf/subscribe [::mat])]
[:<>
[:button {:on-click fit-stage! :title "Fit stage and surrounding workspace in view"} "fit"]
[:details.passepartout-controls
[:summary "passepartout"]
[:div.view-popout
[:label "Outside margin (px)"
[:input {:type "number" :min 0 :max 1000 :value margin
:on-change #(let [v (js/parseInt (.. % -target -value))]
(when (js/Number.isFinite v) (rf/dispatch [::mat :margin (max 0 (min 1000 v))])))}]]
[:label "Shade outside export bounds"
[:input {:type "range" :min 0 :max 1 :step 0.05 :value opacity
:on-change #(rf/dispatch [::mat :opacity (js/parseFloat (.. % -target -value))])}]]
[:p "Draw outside the rectangle. Exports trim to the symbol’s dimensions."]]]]))

View file

@ -1,6 +1,6 @@
(ns arthur.ui.palette
"The palette: a grid of the open palette's slots under the tools, and the
palette asset it is, in the options bar.
palette asset it is, beside that grid.
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
@ -176,10 +176,19 @@
(defn assets
"Which palette asset the grid shows, and a new or duplicated one, for the
options bar."
tool strip, with a popout for the full asset controls."
[]
(let [[clip pid palette] (shown)]
[:div.palette-assets
[:details.palette-assets
{:on-toggle (fn [e]
(let [el (.-currentTarget e)
box (.getBoundingClientRect el)
pop (.querySelector el ".palette-popout")]
(set! (.. pop -style -left) (str (+ 4 (.-right box)) "px"))
(set! (.. pop -style -top) (str (max 8 (min (.-top box) (- (.-innerHeight js/window) 160))) "px"))))}
[:summary {:title (:name palette)} [:span (:name palette)]]
[:div.palette-popout
[:strong (:name palette)]
[:select {:value (str pid)
:title "palette asset"
:on-change (fn [e]
@ -191,4 +200,4 @@
^{: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])} "clone"]]]))

View file

@ -32,6 +32,7 @@
[arthur.subs.ui :as ui-sub]
[arthur.ui.canvas :as canvas]
[arthur.ui.tracing :as tracing]
[arthur.ui.layout :as layout]
[re-frame.core :as rf]
[reagent.ratom :as ratom]))
@ -128,6 +129,7 @@
:frames @(rf/subscribe [::render/frames])
:width @(rf/subscribe [::sub/width])
:height @(rf/subscribe [::sub/height])
:mat @(rf/subscribe [::layout/mat])
:tracing t
:frame @(rf/subscribe [::sub/frame])
:playing? @(rf/subscribe [::sub/playing?])
@ -144,7 +146,7 @@
;; 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)))
(when-not (and (identical? was now) (= was-t t) (= pen (:pen before)) (= (:mat before) (:mat @snapshot)))
(repaint!))))))
;; The brush or eraser stroke being painted: its mask, mutated in place as the
@ -259,13 +261,21 @@
(as-> ops (reduce #(clip/in-layer %1 target (poly (outline/join %2) {:color 0 :knock knock}))
ops rings)))))
(defn- shifted-op [op margin]
(cond-> op
(:pts op) (assoc :pts (let [pts (:pts op) n (* 2 (:n op)) shifted (js/Float64Array. n)]
(dotimes [i n] (aset shifted i (+ margin (aget pts i))))
shifted))
(:cx op) (update :cx + margin)
(:cy op) (update :cy + margin)))
(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
rasterised before the next frame is asked for."
[f]
(let [{:keys [canvas]} @state
{:keys [resolver palette ramp width height tracing playing?]} @snapshot]
{:keys [resolver palette ramp width height tracing playing? mat]} @snapshot]
(when (and canvas resolver width height)
;; User Timing, so a profile in the DevTools performance panel has named
;; spans in the Timings track instead of a wall of anonymous frames. Three
@ -274,7 +284,8 @@
;; THE STAGE IS THE CLIP'S, not a constant. Project dimensions are
;; independent of the footage, so the size the frame is rasterised at comes
;; out of the document like everything else.
(let [ras (raster-for width height)
(let [margin (:margin mat 100)
ras (raster-for (+ width (* 2 margin)) (+ height (* 2 margin)))
{traces true picture false} (group-by #(= :trace (:kind %)) (resolver f))
;; A layer switched off, or all of them, is not on the stage at all:
;; not painted and not there to be clicked.
@ -285,10 +296,10 @@
(swap! state assoc :ops (into (vec picture) traces))
(-> ras
(raster/clear! bg)
(raster/draw-ops! (with-previews picture palette active)))
(raster/draw-ops! (map #(shifted-op % margin) (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!))
(tracing/paint! traces (assoc tracing :width (+ width (* 2 margin)) :origin margin :playing? playing?) repaint!))
(js/performance.measure "arthur/resolve+draw" "arthur/paint:start" "arthur/blit:start")
(js/performance.measure "arthur/paint" "arthur/paint:start")
;; User Timing entries otherwise accumulate forever in the browser's

View file

@ -32,20 +32,17 @@
[re-frame.core :as rf]
[reagent.core :as r]))
;; THE ZOOM IS NOT A CONSTANT ANY MORE — it is `ui/layout`'s, an integer in
;; [1 8], 2 to begin with. It scales the canvas with CSS and never its backing
;; store, so the browser suite still reads 320x200 of real pixels off
;; `canvas.stage` whatever the view is zoomed to; see `ui/canvas`.
;; Pointer coordinates come from the SVG transform, including the outside margin.
(defn stage-point
"Where a pointer event landed, in stage pixels. Shared by the vertex editor and
by a drop out of the media pool, which is the whole reason it is public."
[event w h]
(let [box (.getBoundingClientRect (.-currentTarget event))]
[(-> (/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
js/Math.round (max 0) (min (dec w)))
(-> (/ (* (- (.-clientY event) (.-top box)) h) (.-height box))
js/Math.round (max 0) (min (dec h)))]))
(defn- event-point [element event]
(let [svg (if (= "svg" (.-tagName element)) element (.querySelector element "svg.paint-overlay"))
pt (.createSVGPoint svg)]
(set! (.-x pt) (.-clientX event))
(set! (.-y pt) (.-clientY event))
(let [p (.matrixTransform pt (.inverse (.getScreenCTM svg)))] [(.-x p) (.-y p)])))
(defn stage-point [event _w _h]
(mapv js/Math.round (event-point (.-currentTarget event) event)))
(defn- pairs [pts] (mapv vec (partition 2 pts)))
@ -115,9 +112,7 @@
"Where a pointer event is, in stage pixels, unrounded and unclamped: a drag
holding the pointer may leave the stage and still be moving something."
[^js svg event w h]
(let [box (.getBoundingClientRect svg)]
[(/ (* (- (.-clientX event) (.-left box)) w) (.-width box))
(/ (* (- (.-clientY event) (.-top box)) h) (.-height box))]))
(event-point svg event))
;; The move, turn or scale being dragged, as `dragging` is for a vertex: the
;; placement and transform it started from, and where. What it makes of the
@ -420,7 +415,8 @@
(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)
m (outline/stamp! (let [margin (:margin @(rf/subscribe [::layout/mat]))]
(assoc (outline/mask (+ (:w ctx) (* 2 margin)) (+ (:h ctx) (* 2 margin))) :origin [(- margin) (- margin)])) p p size)
s (cond
;; The brush's target is the creation target, which the player
;; reads for itself.
@ -503,7 +499,7 @@
[:circle {:class (str "first" (when (and hover (closes? draft hover)) " closing"))
:cx fx :cy fy :r 1.8}]])))
(defn- overlay [w h zoom]
(defn- overlay [w h zoom margin opacity]
(let [tool @(rf/subscribe [::sub/tool])
draft @(rf/subscribe [::sub/draft])
hover @(rf/subscribe [::sub/hover])
@ -532,8 +528,8 @@
mark @marquee]
[: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)
:width (* zoom (+ w (* 2 margin))) :height (* zoom (+ h (* 2 margin)))
:view-box (str (- margin) " " (- margin) " " (+ w (* 2 margin)) " " (+ h (* 2 margin)))
:tab-index -1
:on-pointer-down
(fn [^js event]
@ -619,6 +615,9 @@
(reset! dragging nil) (reset! marquee nil)
(reset! painting nil) (player/stroke! nil)
(let-go! false))}
[:path {:d (str "M" (- margin) " " (- margin) "h" (+ w (* 2 margin)) "v" (+ h (* 2 margin)) "h" (- (+ w (* 2 margin))) "z M0 0v" h "h" w "v" (- h) "z")
:fill "#000" :fill-rule "evenodd" :opacity opacity :pointer-events "none"}]
[:rect {:x 0 :y 0 :width w :height h :fill "none" :stroke "#aaa" :vector-effect "non-scaling-stroke" :pointer-events "none"}]
[ghost]
(when (seq selected-pts)
[:polygon.selected-paint-outline
@ -638,6 +637,50 @@
(when pen? [draft-lines draft hover])
(when paints? [cursor tool])]))
(defonce space-held? (atom false))
(defonce pan (atom nil))
(defonce navigation-keys
(when (exists? js/window)
(.addEventListener js/window "keydown"
(fn [e] (when (and (= "Space" (.-code e))
(not (#{"INPUT" "TEXTAREA" "SELECT"} (.-tagName (.-target e)))) )
(.preventDefault e) (reset! space-held? true))))
(.addEventListener js/window "keyup" #(when (= "Space" (.-code %)) (reset! space-held? false)))
(.addEventListener js/window "blur" #(do (reset! space-held? false) (reset! pan nil)))))
(defn- navigation []
{:title "Wheel to zoom · Space-drag or middle-drag to pan"
:ref (fn [el]
(when el
(set! (.-onwheel el)
(fn [e]
(.preventDefault e)
(let [z @(rf/subscribe [::layout/zoom :stage])
wrap (.querySelector el ".stage-wrap")
wb (.getBoundingClientRect wrap)
x (- (.-clientX e) (.-left wb)) y (- (.-clientY e) (.-top wb))
next (max 0.1 (min 16 (* z (js/Math.exp (* -0.002 (.-deltaY e))))))]
(rf/dispatch-sync [::layout/set :stage next])
(js/requestAnimationFrame
(fn []
(let [nb (.getBoundingClientRect wrap)]
(set! (.-scrollLeft el) (+ (.-scrollLeft el) (- (+ (.-left nb) (* x (/ next z))) (.-clientX e))))
(set! (.-scrollTop el) (+ (.-scrollTop el) (- (+ (.-top nb) (* y (/ next z))) (.-clientY e)))))))))))
nil)
:on-pointer-down-capture
(fn [e] (when (or (= 1 (.-button e)) (and (= 0 (.-button e)) @space-held?))
(.preventDefault e) (.stopPropagation e)
(let [el (.-currentTarget e)]
(reset! pan [(.-clientX e) (.-clientY e) (.-scrollLeft el) (.-scrollTop el)])
(.setPointerCapture el (.-pointerId e)))))
:on-pointer-move-capture
(fn [e] (when-let [[x y sx sy] @pan]
(.stopPropagation e)
(set! (.-scrollLeft (.-currentTarget e)) (+ sx (- x (.-clientX e))))
(set! (.-scrollTop (.-currentTarget e)) (+ sy (- y (.-clientY e))))))
:on-pointer-up-capture (fn [e] (when @pan (.stopPropagation e) (reset! pan nil)))
:on-pointer-cancel-capture (fn [_] (reset! pan nil))})
(defn view []
;; Reactive on the clip's dimensions, so selecting a clip of another size
;; resizes the canvas. `ui/canvas` guards the width assignment — which
@ -651,15 +694,19 @@
destination @(rf/subscribe [::sub/creation-target])
destination-name (when-let [sid (:sid destination)]
(clip/symbol-name clip sid))
zoom @(rf/subscribe [::layout/zoom :stage])]
zoom @(rf/subscribe [::layout/zoom :stage])
{:keys [margin opacity]} @(rf/subscribe [::layout/mat])
vw (+ w (* 2 margin)) vh (+ h (* 2 margin))]
[:div.stage-area
(navigation)
[:div.stage-wrap
;; A drop on the stage lands at the PLAYHEAD, where the pointer is in space;
;; a drop on the timeline lands where the pointer is in time.
;; `dragenter` is cancelled as well as `dragover`: a drop target has to
;; accept on BOTH, and the element under the pointer changes whenever the
;; preview re-renders beneath it, which fires a fresh `dragenter`.
{:on-drag-enter (fn [^js event] (when (drag/accepts?) (.preventDefault event)))
{:data-width vw :data-height vh
:on-drag-enter (fn [^js event] (when (drag/accepts?) (.preventDefault event)))
:on-drag-over (fn [^js event]
(when (drag/accepts?)
(.preventDefault event)
@ -671,12 +718,12 @@
(.preventDefault event)
(drag/land! frame (stage-point event w h)))}
[:canvas.stage {:ref #(player/set-canvas! %)
:width w :height h
:style {:width (str (* zoom w) "px")
:height (str (* zoom h) "px")}}]
:width vw :height vh
:style {:width (str (* zoom vw) "px")
:height (str (* zoom vh) "px")}}]
[:canvas.tracing {:ref #(tracing/set-canvas! %)
:width (* zoom w) :height (* zoom h)}]
[overlay w h zoom]]
:width (* zoom vw) :height (* zoom vh)}]
[overlay w h zoom margin opacity]]
(when destination-name
[:div.stage-target "creating in " [:strong destination-name]])
[tools/adjust-last]]))

View file

@ -43,6 +43,7 @@
: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/assets]
[palette/grid]]))
(defn- size-control []
@ -85,7 +86,6 @@
[: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")
@ -97,7 +97,8 @@
: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"]]))
[layout/zoomer :stage "the stage"]
[layout/stage-controls]]))
(defn adjust-last
"Blender's Adjust Last Operation, for a brush or eraser stroke: its fit,

View file

@ -124,7 +124,7 @@
"Draw trace ops `ops`, in draw order, at `opacity`, over a stage `width` wide.
`on-ready` is called when a still or a manifest that was missing arrives, to
paint again."
[ops {:keys [opacity width playing?]} on-ready]
[ops {:keys [opacity width playing? origin]} on-ready]
(when-let [^js canvas (:canvas @state)]
(let [ctx (.getContext canvas "2d")
zoom (/ (.-width canvas) width)
@ -148,7 +148,7 @@
(.setTransform ctx
(* zoom (aget m 0)) (* zoom (aget m 1))
(* zoom (aget m 2)) (* zoom (aget m 3))
(* zoom (aget m 4)) (* zoom (aget m 5)))
(* zoom (+ (or origin 0) (aget m 4))) (* zoom (+ (or origin 0) (aget m 5))))
(.drawImage ctx img 0 0 w h))
(when (and playing? (not= frame (get-in was [node :frame])))
(warm! op on-ready)))))))

View file

@ -96,3 +96,12 @@
(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"))))
(deftest a-brush-mask-can-live-outside-the-export-rectangle
(let [m (assoc (outline/mask 60 50) :origin [-20 -20])
normal (outline/stamp! (outline/mask 60 50) [10 12] [30 24] 6)
outside (outline/stamp! m [-10 -8] [10 4] 6)
shift (fn [ring] (mapv #(- % 20) ring))]
(is (= (vec (array-seq (:buf normal))) (vec (array-seq (:buf outside)))))
(is (= (mapv shift (outline/rings normal)) (outline/rings outside)))
(is (neg? (apply min (first (outline/rings outside)))))))

View file

@ -1713,3 +1713,16 @@ button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
border: 1px solid rgba(255, 255, 255, .8);
border-radius: 2px;
}
/* Palette assets stay in the existing narrow tool strip. */
.toolbox .palette-assets { display: block; width: 44px; flex: 0 0 auto; }
.palette-assets summary { cursor: pointer; font-size: 10px; line-height: 1.25; overflow-wrap: anywhere; padding: 3px; }
.palette-popout, .view-popout { position: fixed; z-index: 100; background: var(--pane); color: var(--fg); border: 1px solid var(--line); padding: 10px; box-shadow: 0 4px 16px #0008; line-height: 1.4; }
.palette-popout { left: 52px; width: 230px; display: flex; flex-wrap: wrap; gap: 7px; }
.palette-popout strong { width: 100%; overflow-wrap: anywhere; }
.palette-popout select { width: 100%; }
.view-popout { right: 16px; width: 240px; }
.view-popout label { display: block; margin-bottom: 8px; }
.view-popout input { width: 100%; }
.passepartout-controls summary { cursor: pointer; }
.stage-wrap { flex: 0 0 auto; }