Improve scope zooming

src/Dodge/Update/Camera.hs

@@ -12,9 +12,9 @@ import Dodge.Creature.Test
 import Geometry
 --import Geometry.ConvexPoly
 import Dodge.GameRoom
+import LensHelp
 
 --import qualified Data.List.NonEmpty as NEL
-import Control.Lens
 --import Control.Applicative
 import Data.Maybe
 import Control.Monad
@@ -40,59 +40,40 @@ moveZoomCamera cfig w = w
     & defaultZoom .~ newDefaultZoom
     & itemZoom .~ newItemZoom
   where
-    newvf = _crPos (you w) +.+ fromMaybe (V2 0 0) mscopeoffset
+    cpos =_crPos (you w)
+    newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
+    vfoffset = do
+        iscam <- yourItem w ^? _Just . itScope . scopeIsCamera
+        guard iscam
+        guard (SDL.ButtonRight `S.member` _mouseButtons w)
+        yourItem w ^? _Just . itScope . scopePos
     mscopeoffset = do
         guard (SDL.ButtonRight `S.member` _mouseButtons w)
         yourItem w ^? _Just . itScope . scopePos
-    newcen = newvf +.+ offset
+    newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
     offset = rotateV (_cameraRot w) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w
     --newzoom = changeZoom (_cameraZoom w) idealZoom'
-    newzoom = newDefaultZoom * newItemZoom
+    newzoom = case yourItem w ^? _Just . itScope of
+        Just zs@ZoomScope {} -> _scopeZoom zs
+        _ -> newDefaultZoom * newItemZoom
     idealDefaultZoom = clipZoom wallZoom
-    newDefaultZoom = changeZoom (_defaultZoom w) idealDefaultZoom
-    idealItemZoom 
-        | crIsAiming (you w)
-            = fromMaybe 1 $ fmap zoomFromItem' (yourItem w ^? _Just . itUse . useAim . aimZoom)
-        | otherwise = 1
+    newDefaultZoom = case yourItem w ^? _Just . itScope of
+        Just zs@ZoomScope {} -> _scopeZoom zs
+        _ -> changeZoom (_defaultZoom w) idealDefaultZoom
+    idealItemZoom = fromMaybe 1 $ do
+        guard $ crIsAiming (you w)
+        zoomFromItem' <$> (yourItem w ^? _Just . itUse . useAim . aimZoom)
     newItemZoom = changeZoom (_itemZoom w) idealItemZoom
     changeZoom curZoom idealZoom
       | curZoom > idealZoom + 0.01 = ((zoomOutSpeed-1)*curZoom + idealZoom) / zoomOutSpeed
       | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1)*curZoom + idealZoom) / zoomInSpeed
       | otherwise                  = idealZoom
     wallZoom = farWallDist newvf cfig w
-    idealZoom'
-        | SDL.ButtonRight `S.member` _mouseButtons w 
-            = theScopeZoom * maybe clipZoom zoomFromItem (yourItem w ^? _Just . itUse . useAim . aimZoom) newDefaultZoom
-        | otherwise = newDefaultZoom
 --            = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
     -- these speeds are inverted, larger means slower
     zoomInSpeed  = 25
     zoomOutSpeed = 15
-    theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itScope . scopeZoom
 
-{- Updte the center of the screen camera center and where your avatar's view is from in world. -}
-moveCamera :: Configuration -> World -> World
-moveCamera cfig w = w 
-    & cameraCenter   .~ idealPos
-    & cameraViewFrom .~ camCenter
-  where 
-    camPos = _cameraViewFrom w
-    wallZoom = farWallDist camPos cfig w
-    basezoom = clipZoom wallZoom
-    aimRangeFactor 
-        | _cameraZoom w == 0 = 0
-        | otherwise = fromMaybe 0 (yourItem w ^? _Just . itUse . useAim . aimRange) / _cameraZoom w
-    aimingMult 
-        | SDL.ButtonRight `S.member` _mouseButtons w = 1
-        | otherwise                                  = 0
-    ypos = _crPos $ you w
-    idealPos = camCenter +.+ aimoffset
-    aimoffset = rotateV (_cameraRot w) (0.5 * aimRangeFactor * aimingMult *.* _mousePos w)
-    camCenter  = ypos +.+ scopeOffset
-    scopeOffset = fromMaybe (V2 0 0) $ yourItem w ^? _Just . itScope . scopePos
-    sightFrom = case yourItem w ^? _Just . itScope . scopeIsCamera of
-        Just True -> camCenter
-        _         -> ypos
 
 updateScopeZoom :: World -> World
 updateScopeZoom w 
@@ -109,33 +90,36 @@ updateScopeZoom w
     | otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                                 . itScope %~ updateScope
   where 
-    updateScope (ZoomScope _ _ _ bl) = ZoomScope (V2 0 0) 0 1 bl
+    updateScope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
     updateScope otherAtt = otherAtt
 
 zoomSpeed :: Float
 zoomSpeed = 39/40
--- TODO unify zoom in and out, use scroll speed
+
 zoomInLongGun :: World -> World
 zoomInLongGun w 
-    | currentZoom < 8 = over (wpPointer . itScope . scopePos)
-        (\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep)
-        $ over (wpPointer . itScope . scopeZoom) (/ zoomSpeed)
-        $ decreaseScopeZoomChange
-        w
+    | currentZoom < 8 = w
+        & wpPointer . itScope . scopePos .+.+~ (1-(1*zoomSpeed)) / newzoom *.* mousep
+        & wpPointer . itScope . scopeZoom %~ (/ zoomSpeed)
+        & decreaseScopeZoomChange
     | otherwise = decreaseScopeZoomChange w
   where 
     decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
     wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
     wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
     Just currentZoom = wp ^? itScope . scopeZoom
+    newzoom = fromJust (wp ^? itScope . scopeZoom) / zoomSpeed
     mousep = rotateV (_cameraRot w) $ _mousePos w
 
 zoomOutLongGun :: World -> World
 zoomOutLongGun w 
-    | currentZoom > 0.5 = over (wpPointer . itScope . scopeZoom) (* zoomSpeed) 
-        $ increaseScopeZoomChange w
+    | currentZoom > 0.5 = w
+--        & wpPointer . itScope . scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
+        & wpPointer . itScope . scopeZoom *~ zoomSpeed
+        & increaseScopeZoomChange
     | otherwise = increaseScopeZoomChange w
   where 
+    --mousep = rotateV (_cameraRot w) $ _mousePos w
     increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1
     wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
     wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
@@ -163,7 +147,6 @@ rotateToOverlappingWall w = maybe w dowallrotate
     cr = you w
     p = _crPos cr
 
-
 rotateCameraBy :: Float -> World -> World
 rotateCameraBy x w = w 
     & cameraRot +~ x
@@ -191,35 +174,10 @@ zoomFromItem'
 zoomFromItem' ItZoom {_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac}
     = min zMax $ max zMin zFac
 
-zoomFromItem 
-    :: ItZoom
-    -> Float -- ^ Furthest viewable distance
-    -> Float
-zoomFromItem ItZoom {_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac}
-    = min zMax . max zMin . (zFac *)
 clipZoom 
     :: Float -- ^ Furthest viewable distance
     -> Float
 clipZoom = min 20 . max 0.2
-{- Automatically sets the zoom of the camera according to the surrounding walls.  -}
-autoZoomCamera :: Configuration -> World -> World
-autoZoomCamera cfig w = w & cameraZoom %~ changeZoom
-  where 
-    camPos = _cameraViewFrom w
-    wallZoom = farWallDist camPos cfig w
-    idealZoom
-        | SDL.ButtonRight `S.member` _mouseButtons w 
-            = theScopeZoom * maybe clipZoom zoomFromItem (yourItem w ^? _Just . itUse . useAim . aimZoom) wallZoom
-        | otherwise = clipZoom wallZoom
---            = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
-    changeZoom curZoom 
-      | curZoom > idealZoom + 0.01 = ((zoomOutSpeed-1)*curZoom + idealZoom) / zoomOutSpeed
-      | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1)*curZoom + idealZoom) / zoomInSpeed
-      | otherwise                  = idealZoom
-    -- these speeds are inverted, larger means slower
-    zoomInSpeed  = 25
-    zoomOutSpeed = 15
-    theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itScope . scopeZoom
 
 setViewDistance :: Configuration -> World -> World
 setViewDistance cfig w = w & viewDistance