From 6df315b73dcaed81410577a1c7e7f73d264dfd69 Mon Sep 17 00:00:00 2001
From: Olive Vaughn <olivevaughncode@gmail.com>
Date: Sun, 4 Oct 2026 00:44:47 -0400
Subject: [PATCH] Pan with trackpad scrolling and zoom with pinch gestures

---
 frontend/src/arthur/ui/stage.cljs | 52 ++++++++++++++++++++++++-------
 1 file changed, 40 insertions(+), 12 deletions(-)

diff --git a/frontend/src/arthur/ui/stage.cljs b/frontend/src/arthur/ui/stage.cljs
index 05bf35e..6da1299 100644
--- a/frontend/src/arthur/ui/stage.cljs
+++ b/frontend/src/arthur/ui/stage.cljs
@@ -648,24 +648,52 @@
     (.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))
+
+(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))]
+    (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))))))))
+
 (defn- navigation []
-  {:title "Wheel to zoom · Space-drag or middle-drag to pan"
+  {:title "Two-finger scroll to pan · Pinch or ⌘/Ctrl-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)))))))))))
+                ;; Chromium and Firefox deliver trackpad pinch as Ctrl-wheel.
+                ;; Ordinary scrolling pans without guessing the input device.
+                (when-not @pinch-start-zoom
+                  (let [unit (case (.-deltaMode e) 1 16 2 (.-clientHeight el) 1)
+                        dx (* unit (.-deltaX e)) dy (* unit (.-deltaY e))]
+                    (if (or (.-ctrlKey e) (.-metaKey e))
+                      (zoom-at! el (.-clientX e) (.-clientY e)
+                                (* @(rf/subscribe [::layout/zoom :stage])
+                                   (js/Math.exp (* (if (.-ctrlKey e) -0.01 -0.002) dy))))
+                      (do
+                        (set! (.-scrollLeft el) (+ (.-scrollLeft el) dx))
+                        (set! (.-scrollTop el) (+ (.-scrollTop el) dy))))))))
+            ;; Safari exposes pinch as GestureEvents, with cumulative scale.
+            (set! (.-ongesturestart el)
+              (fn [e]
+                (.preventDefault e)
+                (reset! pinch-start-zoom @(rf/subscribe [::layout/zoom :stage]))))
+            (set! (.-ongesturechange el)
+              (fn [e]
+                (.preventDefault e)
+                (when-let [z @pinch-start-zoom]
+                  (zoom-at! el (.-clientX e) (.-clientY e) (* z (.-scale e))))))
+            (set! (.-ongestureend el)
+              (fn [e] (.preventDefault e) (reset! pinch-start-zoom nil))))
           nil)
    :on-pointer-down-capture
    (fn [e] (when (or (= 1 (.-button e)) (and (= 0 (.-button e)) @space-held?))