More cleverly set maximum view distance for rectangular window sizes

src/Dodge/Base/Collide.hs

@@ -16,7 +16,7 @@ module Dodge.Base.Collide
     , bounceBall
     , bouncePoint
     , ssfold
---    , collidePointUpToIndirectMinDist
+    , collidePointUpToIndirectMinDist
     , wlIsOpaque
     , wlIsSeeThrough
     , wallsOnCirc

src/Dodge/CullBox.hs

@@ -1,6 +1,8 @@
 module Dodge.CullBox 
-    (cullBox
-    ) where
+    ( cullBox
+    , findBoundDists
+    ) 
+    where
 import Dodge.Data
 --import Dodge.GameRoom
 import Dodge.Base.Window
@@ -11,6 +13,16 @@ import Dodge.Update.Camera
 
 --import Data.Maybe (mapMaybe)
 
+findBoundDists :: Configuration -> World -> (Float,Float,Float,Float)
+findBoundDists cfig w
+    | debugOn Bound_box_screen cfig = (hh,-hh,hw,-hw)
+    | otherwise = f $ farWallDistDirection (_cameraCenter w) w
+  where
+    f (Just a,Just b,Just c,Just d) = (max 0 a,min 0 b,max 0 c,min 0 d)
+    f _ = (0,0,0,0)
+    hw = halfWidth cfig
+    hh = halfHeight cfig
+
 cullBox :: Configuration -> World -> [Point2]
 --cullBox cfig w = farWallPoints cp w
 cullBox cfig w' 
@@ -20,9 +32,3 @@ cullBox cfig w'
   where
     f (Just a,Just b,Just c,Just d) = (max 0 a,min 0 b,max 0 c,min 0 d)
     f _ = (0,0,0,0)
---    --mapMaybe (fmap (fst . _wlLine . snd) . f) $ screenPolygon cfig w
---  where
---    grs = filter (pointInOrOnPolygon cp . _grBound) (_gameRooms w)
---    cp = _cameraCenter w
---    f p = collidePointWallsWall cp p $ wallsAlongLine cp p w
---

src/Dodge/Data.hs

@@ -100,6 +100,7 @@ data World = World
     , _cameraViewFrom       :: Point2
     , _viewDistance         :: Float
     , _boundBox             :: [Point2]
+    , _boundDist            :: (Float,Float,Float,Float) -- NSEW, S and W negative
     , _creatures            :: IM.IntMap Creature
     , _creaturesZone        :: Zone (IM.IntMap Creature)
     , _creatureGroups       :: IM.IntMap CrGroupParams

src/Dodge/Default/World.hs

@@ -108,7 +108,8 @@ defaultWorld = World
     , _genRooms = IM.empty
     , _deathDelay = Nothing
     , _testFloat = 0
-    , _boundBox = square 1000
+    , _boundBox = square 100
+    , _boundDist = (100,-100,100,-100)
     }
 youLight :: TempLightSource
 youLight = TLS 

src/Dodge/Initialisation.hs

@@ -41,6 +41,6 @@ initialWorld = defaultWorld
     }
 
 testStringInit :: Configuration -> World -> [String]
-testStringInit cfig _ = [show $ _windowY cfig]
+testStringInit _ w = [show $ _boundDist w]
 --testStringInit = map (show . _drStatus) . IM.elems . _doors
 --testStringInit = const . const [] 

src/Dodge/Update.hs

@@ -103,6 +103,7 @@ functionalUpdate cfig w = checkEndGame
 
 updateBoundBox :: Configuration -> World -> World
 updateBoundBox cfig w = w & boundBox .~ cullBox cfig w
+    & boundDist .~ findBoundDists cfig w
 
 mcChooseUpdate :: Machine -> Machine -> World -> World
 mcChooseUpdate mc mc'

src/Dodge/Update/Camera.hs

@@ -75,7 +75,13 @@ moveZoomCamera cfig w = w
       | 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
+    --wallZoom = farWallDist newvf cfig w
+    wallZoom = min4 (_boundDist w)
+    min4 (a,b,c,d) = minimum [hh/maxd a,hh/maxd (-b),hw/maxd c,hw/maxd (-d)]
+    maxd = max distFromEqmnt
+    distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w
+    hw = halfWidth  cfig
+    hh = halfHeight cfig
 --            = maybe clipZoom zoomFromItem (yourItem w ^? itZoom) wallZoom
     -- these speeds are inverted, larger means slower
     zoomInSpeed  = 25
@@ -201,22 +207,6 @@ setViewDistance cfig w = w & viewDistance
     .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w
 --    .~ max (halfWidth cfig) (halfHeight cfig) / _cameraZoom w
 
-
--- TODO consider adding visible/nearby creatures as view points
-farWallDist :: Point2 -> Configuration -> World -> Float
---farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
-farWallDist p cfig w = (winFac /) 
-    . min maxViewDistance $ ssfold (> maxViewDistance) findMax distFromEqmnt vps
-  where
-    findMax curMax pout = max curMax $ dist p $ collidePointUpToIndirectMinDist p pout curMax wos
-    hw = halfWidth  cfig
-    hh = halfHeight cfig
-    winFac = min hw hh
-    vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs
-    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
-    wos = wallsOnScreen cfig w
-    distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w
-
 streamViewpoints :: Monad m => Point2 -> World -> Stream (Of Point2) m ()
 {-# INLINE streamViewpoints #-}
 streamViewpoints p w = flip S.for (gameRoomViewpoints p)