Improve scope zooming

src/Dodge/Data.hs

@@ -147,6 +147,7 @@ data World = World
     , _genPlacements        :: IM.IntMap [(Placement,Int)]
     , _genRooms             :: IM.IntMap Room
     , _deathDelay           :: Maybe Int
+    , _testFloat            :: Float
     }
 
 newtype GenParams = GenParams

src/Dodge/Default/World.hs

@@ -104,6 +104,7 @@ defaultWorld = World
     , _genPlacements = IM.empty
     , _genRooms = IM.empty
     , _deathDelay = Nothing
+    , _testFloat = 0
     }
 youLight :: TempLightSource
 youLight = TLS 

src/Dodge/Initialisation.hs

@@ -42,6 +42,7 @@ initialWorld = defaultWorld
 
 testStringInit :: World -> [String]
 testStringInit = const []
+--testStringInit = (:[]) . show . _testFloat
 --testStringInit = map (concatMap $ \(_,ct,_,_) -> show ct) . invertListInvMult . yourInv
 --testStringInit w = fmap (show . _crHammerPosition) . IM.elems $ _creatures w
 --    w = [show $ f $ _roomClipping w]

src/Dodge/Item/Attachment/Data.hs

@@ -28,6 +28,7 @@ data Scope = NoScope
         {_scopePos        :: Point2 -- ^ a camera offset
         ,_scopeZoomChange :: Int
         ,_scopeZoom       :: Float 
+        ,_scopeDefaultZoom  :: Float
         ,_scopeIsCamera   :: Bool   -- ^ if the camera offset is also the center of vision
         }
 

src/Dodge/Item/Weapon/BulletGun/Rod.hs

@@ -132,8 +132,9 @@ sniperRifle = elephantGun
     & itParams . gunBarrels .~ SingleBarrel 0
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
     & itUse . heldScroll  .~ zoomLongGun
-    & itScope   .~ ZoomScope (V2 0 0) 0 1 False
+    & itScope   .~ ZoomScope (V2 0 0) 0 1 0.5 False
     & itTargeting .~ targetLaser
+    & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1}
 machineGun :: Item
 machineGun = bangRod
     & itName .~ "MACHINEGUN"

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -297,7 +297,7 @@ longGun = defaultGun
         & useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
         & heldScroll .~ zoomLongGun
     , _itAttachment = NoItAttachment
-    , _itScope = ZoomScope (V2 0 0) 0 1 False
+    , _itScope = ZoomScope (V2 0 0) 0 1 0.1 False
 --    , _itEffect = itemLaserScopeEffect
     }
 

src/Dodge/Item/Weapon/ZoomScope.hs

@@ -4,6 +4,7 @@ import LensHelp
 
 zoomLongGun :: Float -> Creature -> Item -> Item
 zoomLongGun x _
-    | x > 0 = itScope . scopeZoomChange %~ (max 5 . (+5))
-    | x < 0 = itScope . scopeZoomChange %~ (min (-5) . subtract 5)
+    | x > 0 = itScope . scopeZoomChange %~ (max 10 . (+3))
+    | x < 0 = itScope . scopeZoomChange %~ (min (-10) . subtract 3)
     | otherwise = id
+--zoomLongGun x _ = itScope . scopeZoomChange .~ round (signum x)

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 

src/Shape.hs

@@ -129,7 +129,7 @@ overColObj f (ShapeObj st vs) = ShapeObj st (map (overColVertex f) vs)
 
 overColObjM :: Monad m => (Point4 -> m Point4) -> ShapeObj -> m ShapeObj
 {-# INLINE overColObjM #-}
-overColObjM f (ShapeObj st vs) = ShapeObj st <$> (mapM (svCol f) vs)
+overColObjM f (ShapeObj st vs) = ShapeObj st <$> mapM (svCol f) vs
 
 overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV
 {-# INLINE overColVertex #-}