diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs index d79782c54..817090f6f 100644 --- a/src/Dodge/CullBox.hs +++ b/src/Dodge/CullBox.hs @@ -1,17 +1,14 @@ module Dodge.CullBox - ( cullBox - , findBoundDists + ( makeBoundBox + , updateBounds ) where import Dodge.Data ---import Dodge.GameRoom import Dodge.Base.Window ---import Dodge.Zone import Geometry import Dodge.Update.Camera ---import Shape ---import Data.Maybe (mapMaybe) +import Control.Lens findBoundDists :: Configuration -> World -> (Float,Float,Float,Float) findBoundDists cfig w @@ -23,12 +20,19 @@ findBoundDists cfig w hw = halfWidth cfig hh = halfHeight cfig -cullBox :: Configuration -> World -> [Point2] +makeBoundBox :: Configuration -> World -> [Point2] --cullBox cfig w = farWallPoints cp w -cullBox cfig w' +makeBoundBox cfig w' | debugOn Bound_box_screen cfig = screenPolygon cfig w' | otherwise = let (n,s,e,w) = f $ farWallDistDirection (_cameraCenter w') w' in map ((+.+ _cameraCenter w') . rotateV (_cameraRot w') ) $ rectNSWE n s w e 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) + +updateBounds :: Configuration -> World -> World +updateBounds cfig w = w + & boundDist .~ bdists + & boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e) + where + bdists@(n,s,e,w') = findBoundDists cfig w diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index e7a0e8091..1ad46a1b6 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -2,7 +2,7 @@ module Dodge.Render.Lights ( lightsToRender ) where import Dodge.Data -import Dodge.CullBox +--import Dodge.CullBox import Geometry import Data.Maybe @@ -14,7 +14,7 @@ lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources w) where getLS = getlsparam . _lsParam getTLS = getlsparam . _tlsParam - cbox = cullBox cfig w + cbox = _boundBox w cpos = _cameraCenter w getlsparam ls | not (pointInPolygon lpos cbox) && extraculltest = Nothing diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 637196b8f..6dd5c665b 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -132,7 +132,7 @@ testPic _ _ = mempty drawBoundingBox :: Configuration -> World -> Picture drawBoundingBox cfig w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x] where - (x:xs) = cullBox cfig w + (x:xs) = makeBoundBox cfig w clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (_clPict c c) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 11e1e5ed4..99460567a 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -91,7 +91,7 @@ functionalUpdate cfig w = checkEndGame -- . (youHammerPosition %~ moveHammerUp) . updateTerminal . updateRBList - . updateBoundBox cfig -- where should this go? next to update camera? + . updateBounds cfig -- where should this go? next to update camera? $ updateCloseObjects w where --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w @@ -101,10 +101,6 @@ functionalUpdate cfig w = checkEndGame (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl -updateBoundBox :: Configuration -> World -> World -updateBoundBox cfig w = w & boundBox .~ cullBox cfig w - & boundDist .~ findBoundDists cfig w - mcChooseUpdate :: Machine -> Machine -> World -> World mcChooseUpdate mc mc' | _mcHP mc > 0 = _mcUpdate mc mc' diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 43a70c1ba..775824451 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -29,7 +29,7 @@ thingsHit -> Stream (Of (Point2, Either Creature Wall)) Identity () thingsHit sp ep w | sp == ep = S.each [] - | otherwise = fmap (const ()) $ S.mergeOn (dist sp . fst) crs wls + | otherwise = void $ S.mergeOn (dist sp . fst) crs wls where crs :: Stream (Of (Point2, Either Creature Wall)) Identity () crs = sortStreamOn (dist sp . fst)