Cleanup zoning

This commit is contained in:
2022-06-28 13:43:37 +01:00
parent e770fba7bf
commit 9801a40b9e
14 changed files with 84 additions and 106 deletions
+7 -7
View File
@@ -94,7 +94,7 @@ collidePointTestFilter t sp ep = runIdentity
collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall)
collidePointWallsFilterStream t sp ep = collidePoint sp ep
. S.filter t
. wallsAlongLine sp ep
. wlsNearSeg sp ep
overlapSegWalls :: Point2 -> Point2 -> Stream (Of Wall) Identity ()
-> Stream (Of (Point2,Wall)) Identity ()
@@ -105,7 +105,7 @@ visibleWalls sp ep = S.take 1 <=< -- hlint, was using join and fmap
( S.span (not . wlIsOpaque . snd)
. sortStreamOn (dist sp . fst)
. overlapSegWalls sp ep
. wallsAlongLine sp ep )
. wlsNearSeg sp ep )
allVisibleWalls :: World -> Stream (Of (Point2,Wall)) Identity ()
allVisibleWalls w = concats $ S.subst (flip (visibleWalls vPos) w . (+.+ vPos)) $ S.each (nRays 20)
@@ -236,7 +236,7 @@ collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
- Note no check on whether the wall is walkable. -}
circOnSomeWall :: Point2 -> Float -> World -> Bool
circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine)
. wallsNearPoint p
. wlsNearPoint p
-- = any (\(x,y) -> circOnSeg x y p rad)
-- . fmap _wlLine
-- . IM.elems
@@ -300,23 +300,23 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-}
hasLOS p1 p2 = not
. collidePointTestFilter (const True) p1 p2
. wallsAlongLine p1 p2
. wlsNearSeg p1 p2
hasButtonLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasButtonLOS #-}
hasButtonLOS p1 p2 = not
. collidePointTestFilter (not . _wlTouchThrough) p1 p2
. wallsAlongLine p1 p2
. wlsNearSeg p1 p2
hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
hasLOSIndirect p1 p2 = not
. collidePointTestFilter wlIsOpaque p1 p2
. wallsAlongLine p1 p2
. wlsNearSeg p1 p2
isWalkable :: Point2 -> Point2 -> World -> Bool
isWalkable p1 p2 = not
. collidePointTestFilter (not . (^?! wlPathable)) p1 p2
. wallsAlongLine p1 p2
. wlsNearSeg p1 p2
canSee :: Int -> Int -> World -> Bool
canSee i j w = hasLOS p1 p2 w