diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 66ffb371d..8cec530a8 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -16,7 +16,7 @@ module Dodge.Base.Collide , bounceBall , bouncePoint , ssfold --- , collidePointUpToIndirectMinDist + , collidePointUpToIndirectMinDist , wlIsOpaque , wlIsSeeThrough , wallsOnCirc diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs index 42a186ff9..d79782c54 100644 --- a/src/Dodge/CullBox.hs +++ b/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 --- diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index b54a5cf13..916d54e6d 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 04abc1dc7..484eca525 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 0d6d19a3f..bc9c5530e 100644 --- a/src/Dodge/Initialisation.hs +++ b/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 [] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index f8340d168..11e1e5ed4 100644 --- a/src/Dodge/Update.hs +++ b/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' diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 04dbddbdf..3ade6e5d8 100644 --- a/src/Dodge/Update/Camera.hs +++ b/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)