Fix laser targeting draw when creature offscreen

src/Dodge/Creature.hs

@@ -94,10 +94,10 @@ longCrit = defaultCreature
         , _crStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
         , _crGoal       = []
         }
-    , _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
+    , _crInv = IM.fromList [(0,sniperRifle),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
-    , _crHP = 300
+    , _crHP = 150
     }
 multGunCrit :: Creature
 multGunCrit = defaultCreature
@@ -173,9 +173,9 @@ testInventory = IM.fromList $ zip [0..]
     , makeTypeCraftNum 1 LIGHTER
     , makeTypeCraftNum 5 TUBE
 --    , makeTypeCraftNum 5 CREATURESENSOR
---    , makeTypeCraftNum 3 PRISM
+    , makeTypeCraftNum 3 PRISM
-    , makeTypeCraftNum 3 DRUM
+--    , makeTypeCraftNum 3 DRUM
-    , makeTypeCraftNum 3 PUMP
+--    , makeTypeCraftNum 3 PUMP
 --    , makeTypeCraftNum 1 MAGNET
     , makeTypeCraftNum 5 HARDWARE
     , makeTypeCraftNum 3 SPRING

src/Dodge/Creature/State.hs

@@ -150,10 +150,11 @@ invSideEff cr w = weaponReloadSounds cr
         itpointer = creatures . ix (_crID cr) . crInv . ix i
 
 doHeldItemTargeting :: Creature -> World -> World
-doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . tgUpdate of
+doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting of
     Nothing -> w
-    Just f  -> w & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting
+    Just NoTargeting -> w
-        %~ f (_crInv cr IM.! _crInvSel cr) cr w
+    Just t  -> let (w',t') =  _tgUpdate t (_crInv cr IM.! _crInvSel cr) cr w t
+        in w' & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting .~ t'
 
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of

src/Dodge/Data.hs

@@ -71,6 +71,7 @@ data World = World
     , _cameraRot            :: Float
     , _cameraZoom           :: Float
     , _cameraViewFrom       :: Point2
+    , _viewDistance         :: Float
     , _creatures            :: IM.IntMap Creature
     , _creaturesZone        :: Zone (IM.IntMap Creature)
     , _creatureGroups       :: IM.IntMap CrGroupParams
@@ -381,7 +382,7 @@ data Targeting
     = NoTargeting
     | TargetingOnHeld
         { _tgPos    :: Maybe Point2
-        , _tgUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+        , _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
         , _tgDraw   :: Int -> Item -> Creature -> World -> Picture
         , _tgID     :: Maybe Int
         , _tgActive :: Bool

src/Dodge/Default/World.hs

@@ -25,6 +25,7 @@ defaultWorld = World
     , _cameraRot = 0
     , _cameraZoom = 1
     , _cameraViewFrom = V2 0 0
+    , _viewDistance = 1000
     , _modifications = IM.empty
     , _creatures = IM.empty
     , _creaturesZone = Zone IM.empty

src/Dodge/Floor.hs

@@ -34,8 +34,9 @@ import System.Random
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
-    , [SpecificRoom shootingRange]
+    , [SpecificRoom $ fmap (return . PassDown) longRoom]
     , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
+    , [SpecificRoom randomChallenges]
     , [AnoApplyInt 1 lasSensorTurretTest]
 --    ,[ChainAnos 
 --        [[SetLabel 0 $ return $ roomRectAutoLinks 200 200 

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -20,12 +20,13 @@ import Dodge.Item.Weapon.LaserPath
 --import Dodge.Item.Attachment.Data
 import Dodge.Picture.Layer
 import Dodge.Creature.Test
+import Dodge.WorldEvent.HelperParticle
 import Picture
 import Geometry.Vector
 import Geometry.Data
+import LensHelp
 
 import Data.Maybe
-import Control.Lens
 import qualified Data.Set as S
 import qualified SDL
 {- | Automatically send out radar pulses that detect walls.  -}
@@ -52,7 +53,7 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
 defaultTargeting :: Targeting
 defaultTargeting = TargetingOnHeld
     { _tgPos = Nothing
-    , _tgUpdate = \_ _ _ -> id
+    , _tgUpdate = \_ _ w t -> (w,t)
     , _tgDraw = \_ _ _ _ -> mempty
     , _tgID = Nothing
     , _tgActive = False
@@ -100,28 +101,31 @@ targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
     thecolor | _tgActive $ _itTargeting it = red
         | otherwise = blue
 
-targetCursorUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetCursorUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
 targetCursorUpdate _ _ w t
-    | SDL.ButtonRight `S.member` _mouseButtons w = t
+    | SDL.ButtonRight `S.member` _mouseButtons w = (,) w $ t
         & tgPos . _Just .~ mouseWorldPos w
         & tgActive .~ True
-    | otherwise = t & tgPos %~ const Nothing
+    | otherwise = (,) w $ t & tgPos %~ const Nothing
         & tgActive .~ False
 
-targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
 targetRBPressUpdate _ _ w t
-    | SDL.ButtonRight `S.member` _mouseButtons w = t
+    | SDL.ButtonRight `S.member` _mouseButtons w = (w,t
         & tgPos %~ maybe (Just $ mouseWorldPos w) Just
         & tgActive .~ True
-    | otherwise = t & tgPos %~ const Nothing
+        )
+    | otherwise = (w,t & tgPos %~ const Nothing
         & tgActive .~ False
+        )
 
-targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
 targetRBCreatureUpdate _ _ w t
     | SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just)
-                = t & updatePos
+                = (w,t & updatePos
         & tgActive .~ True
-    | otherwise = t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
+        )
+    | otherwise = (,) w $ t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
         & updatePos
         & tgActive .~ False
   where
@@ -131,30 +135,40 @@ targetRBCreatureUpdate _ _ w t
     posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
 
 targetLaserDraw :: Int -> Item -> Creature -> World -> Picture
-targetLaserDraw _ it _ _ = fromMaybe mempty $ do
+targetLaserDraw _ it _ _ = mempty 
-    ps <- it ^? itTargeting . tgPoints
+--  fromMaybe mempty $ do
-    return $ setLayer 1 $ pictures
+--    ps <- it ^? itTargeting . tgPoints
-        [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 ps
+--    return $ setLayer 1 $ pictures
-        , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  ps
+--        [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 ps
-        ]
+--        , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  ps
-  where
+--        ]
-    wpammo = _itConsumption it
+--  where
-    reloadFrac 
+--    wpammo = _itConsumption it
-        | _ammoLoaded wpammo == 0 = 1
+--    reloadFrac 
-        | otherwise = case _reloadState wpammo of
+--        | _ammoLoaded wpammo == 0 = 1
-            Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo)
+--        | otherwise = case _reloadState wpammo of
-            Nothing' -> 1
+--            Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo)
-    col = mixColors reloadFrac (1-reloadFrac) red green
+--            Nothing' -> 1
-targetLaserUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+--    col = mixColors reloadFrac (1-reloadFrac) red green
+targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
 targetLaserUpdate _ cr w t
-    | crIsAiming cr = t
+    | crIsAiming cr = (addLaserPic w,t
         & tgPos    .~ fmap fst mp
         & tgPoints .~ sp:ps
         & tgActive .~ True
-    | otherwise = t & tgPos %~ const Nothing
+        )
+    | otherwise = (w,t & tgPos %~ const Nothing
         & tgPoints .~ []
         & tgActive .~ False
+        )
   where
     (mp, ps) = reflectLaserAlong 0.2 [] sp ep w
     sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
-    ep = sp +.+ 1000 *.* normalizeV (mouseWorldPos w -.- sp)
+    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
+    addLaserPic = instantParticles .:~ Particle
+        { _ptDraw = const $ setLayer 1 $ pictures
+            [ setDepth 19   . color (brightX 0 0.5 red) $ thickLine 5 (sp:ps)
+            , setDepth 19.5 . color (brightX 5 1 red)  $ thickLine 1  (sp:ps)
+            ]
+        , _ptUpdate = ptSimpleTime 1
+        }

src/Dodge/LevelGen/Data.hs

@@ -171,7 +171,7 @@ jsps :: Point2 -> Float -> PSType -> Maybe Placement
 jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
 
 jsps0 :: PSType -> Maybe Placement
-jsps0 pst = Just $ sPS (V2 0 0) 0 pst
+jsps0 = Just . sPS (V2 0 0) 0
 
 sps0 :: PSType -> Placement
 sps0 = sPS (V2 0 0) 0

src/Dodge/Render/Lights.hs

@@ -13,7 +13,6 @@ lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTL
     getLS  = getlsparam . _lsParam
     getTLS = getlsparam . _tlsParam 
     getlsparam ls
-        | dist campos (fst2 $ _lsPos ls) > 1000 = Nothing
+        | dist (_cameraCenter w) (fst2 $ _lsPos ls) > _viewDistance w + _lsRad ls = Nothing
         | otherwise = Just ( _lsPos ls,  _lsRad ls^(2::Int) , _lsCol ls)
-    campos = _cameraCenter w
     fst2 (V3 a b _) = V2 a b

src/Dodge/Render/ShapePicture.hs

@@ -25,6 +25,7 @@ import qualified Data.Map.Strict as M
 --import Control.Lens
 --import Data.Maybe
 
+-- TODO only filter out shapes outside the range of the furthest shown light source
 worldSPic :: Configuration -> World -> SPic
 worldSPic cfig w = 
     (extraShapes w, extraPics cfig w)
@@ -35,13 +36,13 @@ worldSPic cfig w =
     <> foldMap mcSPic (filtOn _mcPos _machines)
   where
     filtOn f g = IM.filter (pointIsClose . f) (g w)
-    pointIsClose p = dist camCen p < winSize
+    pointIsClose p = dist camCen p < 30 + _viewDistance w
-    winSize = 30 + max (_windowX cfig) (_windowY cfig)
     camCen = _cameraCenter w
 
 extraShapes :: World -> Shape
 extraShapes = _foregroundShape
 
+-- TODO filter out pictures not in the frame
 extraPics :: Configuration -> World -> Picture
 extraPics cfig w = pictures (_decorations w)
     <> concatMapPic (dbArg _ptDraw) (_particles    w)
@@ -53,7 +54,6 @@ extraPics cfig w = pictures (_decorations w)
     <> viewBoundaries cfig w
     <> drawPathing cfig w
 
--- TODO remove duplicate!
 testPic :: World -> Picture
 testPic _ = []
 clDraw :: Cloud -> Picture
@@ -73,7 +73,7 @@ mcSPic bt = uncurryV translateSPf (_mcPos bt)
     $ rotateSP (_mcDir bt) (_mcDraw bt bt)
 
 soundPics :: Configuration -> World -> Picture
-soundPics cfig w 
+soundPics cfig w
     | _show_sound cfig = pictures $ M.map (soundPic cfig w) $ _playingSounds w
     | otherwise = []
 

src/Dodge/Room/Link.hs

@@ -14,7 +14,6 @@ module Dodge.Room.Link
     , randomiseAllLinks
     , shuffleLinks
     , filterLinks
-    , changeLinkTo
     , randomiseOutLinks
     , chooseOneInLink
     , restrictRMInLinksPD
@@ -78,43 +77,10 @@ shuffleLinks r = do
     newLinks <- shuffle $ _rmLinks r
     return $ r {_rmLinks = newLinks }
 
---randomiseLinksBy 
---    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
---    -> Room
---    -> State g Room
---randomiseLinksBy f r = do
---    newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
---    return $ r {_rmOutLinks = init newLinks
---                , _rmInLinks = [last newLinks]
---                }
-
 filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 filterLinks cond r = do
     newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmLinks r
     return $ r {_rmLinks = newLinks}
-{- | Swaps the last link in the list with one that satisfies a given
- - property (it might swap with itself). Unsafe. 
- - Be careful about calling this after changeLinkFrom. -}
--- TODO replace with something more sensible
-changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
-changeLinkTo cond r = do
-    let alllinks = _rmLinks r
-    l <- takeOne $ filter (cond . lnkPosDir) alllinks
-    let l' = l & rlType .~ S.singleton InLink
-    let newLinks = delete l alllinks
-    return $ r & rmLinks .~ (l':newLinks)
-{- | Move a room so that the first link in '_rmInLinks' lines up to 
-an external point and direction.
-This is intended to work when the external point is an outgoing link from another room.
--}
---shiftRoomToLink :: (Point2,Float) -> Room -> Room
---shiftRoomToLink l r 
---    = shiftRoomBy l 
---    . shiftRoomBy (V2 0 0       , pi-a)  
---    $ shiftRoomBy (V2 0 0 -.- p , 0) 
---    r
---  where 
---    (p,a) = lnkPosDir $ head $ _rmInLinks r
 
 doRoomShift :: Room -> Room
 doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm

src/Dodge/Room/Room.hs

@@ -22,8 +22,8 @@ import Dodge.Room.Airlock
 import Geometry
 import Tile
 import MonadHelp
+import LensHelp
 
-import Control.Lens
 import Control.Monad.State
 --import Control.Monad.Loops
 import System.Random
@@ -142,40 +142,30 @@ glassSwitchBackCrits = glassSwitchBack
                 ] ++)
 
 miniTree2 :: RandomGen g => State g (SubCompTree Room)
-miniTree2 = restrictInLinks (\p -> (sndV2 . fst) p < 70) <$> glassSwitchBackCrits 
+miniTree2 =  (glassSwitchBackCrits 
-    >>= randomiseAllLinks 
+    >>= randomiseAllLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70))
     <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
 
 miniRoom3 :: RandomGen g => State g (SubCompTree Room)
 miniRoom3 = do
-        w <- state $ randomR (300,400)
+    w <- state $ randomR (300,400)
-        h <- state $ randomR (300,400)
+    h <- state $ randomR (300,400)
-        let cp = V2 0 (h/2+40)
+    let cp = V2 0 (h/2+40)
-        let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60) 
+    let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60) 
-                                               ,( 10,-60) 
+                                           ,( 10,-60) 
-                                               ,( 10,-80) 
+                                           ,( 10,-80) 
-                                               ,(-10,-80) 
+                                           ,(-10,-80) 
-                                               ]
+                                           ]
-        let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
+    let plmnts = 
-                     ,sPS cp 0        $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+            [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
-                     ,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+                | i <- [0..7::Int]
-                     ,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+            ] ++
-                     ,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+            [ sPS cp (pi/8+fromIntegral i*pi/4) b
-                     ,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+                | i <- [0..7::Int]
-                     ,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+            ] ++ 
-                     ,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+            [ sPS cp 0 $ PutCrit miniGunCrit 
-                     ,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
+            , sPS (V2 (w/2) (h/2)) 0 putLamp ]
-                     ,sPS cp (pi/8)  b
+    fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
-                     ,sPS cp (pi/8+1*pi/4) b
-                     ,sPS cp (pi/8+2*pi/4) b
-                     ,sPS cp (pi/8+3*pi/4) b
-                     ,sPS cp (pi/8+4*pi/4) b
-                     ,sPS cp (pi/8+5*pi/4) b
-                     ,sPS cp (pi/8+6*pi/4) b
-                     ,sPS cp (pi/8+7*pi/4) b
-                     ,sPS (V2 (w/2) (h/2)) 0 putLamp
-                     ]
-        fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
 
 rot90Around :: Point2 -> Point2 -> Point2
 rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -371,26 +361,18 @@ longRoom = do
     h <- state $ randomR (1500,1500)
     let w = 75
     let cond x = (sndV2 . fst) x < h - 40
-    let ws = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
+    let wlsNSEWs wln wls listew = [sps0 $ PutWall (rectNSWE wln wls wallw walle) defaultCrystalWall
-                    [rectNSWE (h-35) (h-135) (-10) 10
+            | (wallw,walle) <- listew ]
-                    ,rectNSWE (h-35) (h-135) 15 35
+    let ws = wlsNSEWs (h-35) (h-135) [(-10,10) , (15,35) , (40,60) , (65,85)]
-                    ,rectNSWE (h-35) (h-135) 40 60
+    let wsDefense = wlsNSEWs 95 70 [(0,25) , (50,75) ]
-                    ,rectNSWE (h-35) (h-135) 65 85
+    brlOffsets <- replicateM 5 $ randInRect (w-20) 900
-                    ]
+    let brls = [ sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel | p <- brlOffsets ]
-    let wsDefense = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
+    let rm = roomRect w (h+70) 1 1 & rmPolys .++~ [rectNSWE h (h-165) (-45) (w+45)]
-                    [rectNSWE 95 70  0 25
+            & rmFloor .~ InheritFloor
-                    ,rectNSWE 95 70 50 75
-                    ]
-    brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
-                            $ replicateM 5 $ randInRect (w-20) 900
-    let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
     return $ restrictInLinks cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
-        [sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
+        [sPS (V2 crx (h-25)) 0 $ PutCrit longCrit
-        ,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
+                | crx <- [12.5,37.5,62.5] ] ++
-        ,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
+        [sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ]
-        ,sPS (V2   25    20 ) 0 putLamp
-        ,sPS (V2   25 (h-10)) 0 putLamp
-        ]
 
 doubleCorridorBarrels :: RandomGen g => State g Room
 doubleCorridorBarrels = do

src/Dodge/Room/Start.hs

@@ -67,14 +67,14 @@ room2 = lasCenSensEdge
 startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 startRoom i = join $ uncurry takeOneWeighted $ unzip 
 --    [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
-    [-- (,) one rezBoxesWp
+    [ (,) one rezBoxesWp
-     (,) one rezBoxesThenWeaponRoom
+    , (,) one rezBoxesThenWeaponRoom
---    , (,) 1 rezBoxThenWeaponRoom
+    , (,) 1 rezBoxThenWeaponRoom
---    , (,) one rezBoxesWpCrit
+    , (,) one rezBoxesWpCrit
---    , (,) 1 $ runPastStart i
+    , (,) 1 $ runPastStart i
     ]
   where
-    one = (1::Float)
+    one = 1::Float
 randomChallenges :: RandomGen g => State g (SubCompTree Room)
 randomChallenges = join $ takeOne
     [fmap (return . UseAll) doubleCorridorBarrels

src/Dodge/RoomLink.hs

@@ -16,7 +16,7 @@ getLinksOfType :: RoomLinkType -> [RoomLink] -> [RoomLink]
 getLinksOfType lt = filter (S.member lt . _rlType)
 
 restrictInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
-restrictInLinks f = rmLinks %~ restrictLinkType InLink f
+restrictInLinks = over rmLinks . restrictLinkType InLink
 
 restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
 restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f

src/Dodge/Update/Camera.hs

@@ -28,7 +28,8 @@ import qualified SDL
 {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; 
 update where your avatar's view is from.  -}
 updateCamera :: Configuration -> World -> World
-updateCamera cfig = rotateCamera cfig . autoZoomCamera cfig . moveCamera . updateScopeZoom 
+updateCamera cfig = rotateCamera cfig . setViewDistance cfig 
+    . autoZoomCamera cfig . moveCamera . updateScopeZoom 
 {- Updte the center of the screen camera center and where your avatar's view is from in world. -}
 moveCamera :: World -> World
 moveCamera w = w 
@@ -169,6 +170,10 @@ autoZoomCamera cfig w = w & cameraZoom %~ changeZoom
     zoomOutSpeed = 15
     theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itScope . scopeZoom
 
+setViewDistance :: Configuration -> World -> World
+setViewDistance cfig w = w & viewDistance 
+    .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w
+
 farWallDist :: Point2 -> Configuration -> World -> Float
 farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
   where