meshsketch: scroll-wheel zoom (lens angle).

1 files changed, 10 insertions, 0 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 8c46d54..6d7e757 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -310,6 +310,16 @@ onEvent w realized ev = do
         EventTypeScroll -> do
             sev <- get ev #scroll
             d <- get sev #direction
+            let δ = case d of
+                    ScrollDirectionDown -> - pi/180
+                    ScrollDirectionUp   -> pi/180
+                    _                   -> 0
+            when (δ /= 0) $ do
+                modifyIORef (stCamera st) $ \cam -> cam
+                    { camHeightAngle   = δ + camHeightAngle cam
+                    , camWorldToScreen = Nothing
+                    , camScreenToWorld = Nothing
+                    }
             put d
             return ()