Fix stage zoom anchoring and continuous passepartout shading

This commit is contained in:
Olive Vaughn 2026-10-04 00:59:08 -04:00
parent e5b61bfcdd
commit f2fc261221
3 changed files with 40 additions and 16 deletions

View file

@ -179,7 +179,7 @@
(defn stage-controls []
(let [{:keys [opacity]} @(rf/subscribe [::mat])]
[:<>
[:button {:on-click fit-stage! :title "Fit stage and surrounding workspace in view"} "fit"]
[:button {:on-click fit-stage! :title "Fit stage in view"} "fit"]
[:details.passepartout-controls
[:summary "passepartout"]
[:div.view-popout

View file

@ -614,8 +614,6 @@
(reset! dragging nil) (reset! marquee nil)
(reset! painting nil) (player/stroke! nil)
(let-go! false))}
[:path {:d (str "M" (- w) " " (- h) "h" (* 3 w) "v" (* 3 h) "h" (* -3 w) "z M0 0v" h "h" w "v" (- h) "z")
:fill "#000" :fill-rule "evenodd" :opacity opacity :pointer-events "none"}]
[ghost]
(when (seq selected-pts)
[:polygon.selected-paint-outline
@ -637,29 +635,48 @@
(defonce space-held? (atom false))
(defonce pan (atom nil))
(defn- stage-key-target? [target]
(and (.closest target ".stage-area")
(not (.closest target "input, textarea, select, button, a, summary, [role='button']"))
(not (.-isContentEditable target))))
(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))))
(fn [e]
(when (and (= "Space" (.-code e))
(not (or (.-ctrlKey e) (.-metaKey e) (.-altKey e)))
(stage-key-target? (.-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)))))
(defonce pinch-start-zoom (atom nil))
(defonce pending-zoom (atom nil))
(defn- zoom-at! [el client-x client-y scale]
(let [z @(rf/subscribe [::layout/zoom :stage])
wrap (.querySelector el ".stage-wrap")
wb (.getBoundingClientRect wrap)
x (- client-x (.-left wb)) y (- client-y (.-top wb))
next (max 0.1 (min 16 scale))]
(let [wrap (.querySelector el ".stage-wrap")
next (max 0.1 (min 16 scale))
pending @pending-zoom]
;; Retain the anchor from the layout before this batch of events. React
;; may not have committed the new dimensions until the animation frame.
(when-not pending
(let [z @(rf/subscribe [::layout/zoom :stage])
box (.getBoundingClientRect wrap)]
(reset! pending-zoom {:x (/ (- client-x (.-left box)) z)
:y (/ (- client-y (.-top box)) z)})))
(swap! pending-zoom assoc :scale next :client-x client-x :client-y client-y)
(rf/dispatch-sync [::layout/set :stage next])
(js/requestAnimationFrame
(fn []
(let [nb (.getBoundingClientRect wrap)]
(set! (.-scrollLeft el) (+ (.-scrollLeft el) (- (+ (.-left nb) (* x (/ next z))) client-x)))
(set! (.-scrollTop el) (+ (.-scrollTop el) (- (+ (.-top nb) (* y (/ next z))) client-y))))))))
(when-not pending
(js/requestAnimationFrame
(fn []
(r/flush)
(let [{:keys [x y scale client-x client-y]} @pending-zoom
box (.getBoundingClientRect wrap)]
(reset! pending-zoom nil)
(set! (.-scrollLeft el) (+ (.-scrollLeft el) (- (+ (.-left box) (* x scale)) client-x)))
(set! (.-scrollTop el) (+ (.-scrollTop el) (- (+ (.-top box) (* y scale)) client-y)))))))))
(defn- navigation []
{:title "Two-finger scroll to pan · Pinch or ⌘/Ctrl-wheel to zoom · Space-drag or middle-drag to pan"
@ -748,6 +765,7 @@
:height (str (* zoom h) "px")}}]
[:canvas.tracing {:ref #(tracing/set-canvas! %)
:width (* zoom w) :height (* zoom h)}]
[:div.stage-shade {:style {:box-shadow (str "0 0 0 100vmax rgba(0,0,0," opacity ")")}}]
[:div.stage-overlay-wrap [overlay w h zoom opacity]]]
(when destination-name
[:div.stage-target "creating in " [:strong destination-name]])