This commit is contained in:
2022-06-26 12:41:15 +01:00
parent 5ba0ca9f9c
commit d386b0ea89
5 changed files with 17 additions and 17 deletions
+12 -8
View File
@@ -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
+2 -2
View File
@@ -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
+1 -1
View File
@@ -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)
+1 -5
View File
@@ -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'
+1 -1
View File
@@ -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)