Broken commit

src/Dodge/HeldScroll.hs

@@ -3,14 +3,61 @@ module Dodge.HeldScroll (
     canHeldScrollAttach,
 ) where
 
-import Control.Lens hiding ((<|), (|>))
+import LensHelp hiding ((<|), (|>))
+import Data.Maybe
+import Control.Monad
+import Geometry
+--import Control.Lens hiding ((<|), (|>))
 import Data.Sequence
 import Dodge.Data.World
+import SDL (MouseButton (..))
+import qualified Data.Map.Strict as M
 
 doHeldScroll :: Int -> ScrollAttachParams -> Float -> World -> World
 doHeldScroll invid hs x w  = case hs of
-    ZoomScrollParams{}-> w
+    ZoomScrollParams{}
+        | SDL.ButtonRight `M.member` _mouseButtons (_input w) -> w &
+            cWorld . lWorld . creatures . ix 0 . crInv . ix invid 
+                . itUse . attachParams . scrollAttachParams %~ doScopeZoom (w ^. input . smoothScrollAmount) mp
+    ZoomScrollParams{} -> w &
+            cWorld . lWorld . creatures . ix 0 . crInv . ix invid 
+                . itUse . attachParams . scrollAttachParams %~ resetscope
+
     CharScrollParams{} -> w & cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itUse . attachParams . scrollAttachParams . scrollChar %~ cycleSignum x
+  where
+    mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
+    resetscope (ZoomScrollParams _ _ defz) = ZoomScrollParams (V2 0 0) defz defz
+    resetscope otherAtt = otherAtt
+
+doScopeZoom :: Int -> Point2 -> ScrollAttachParams -> ScrollAttachParams
+doScopeZoom scrollamount mp sc = case scrollamount of
+    x
+        | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
+        | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
+        | x > 0 -> zoomInLongGun mp sc
+        | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
+        | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
+        | x < 0 -> zoomOutLongGun sc
+        | otherwise -> sc
+
+zoomSpeed :: Float
+zoomSpeed = 39 / 40
+
+zoomInLongGun :: Point2 -> ScrollAttachParams -> ScrollAttachParams
+zoomInLongGun mousep sc = fromMaybe sc $ do
+    curzoom <- sc ^? opticZoom
+    guard $ curzoom < 8
+    return $
+        sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
+            & opticZoom %~ (/ zoomSpeed)
+
+zoomOutLongGun :: ScrollAttachParams -> ScrollAttachParams
+zoomOutLongGun sc = fromMaybe sc $ do
+    curzoom <- sc ^? opticZoom
+    guard $ curzoom > 0.5
+    return $
+        sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
+            & opticZoom *~ zoomSpeed
 
 cycleSignum :: Float -> Seq a -> Seq a
 cycleSignum x