justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Improve line zoning

Browse Source
This commit is contained in:
justin
2021-08-16 14:44:52 +02:00
parent 3192ae628f
commit c58ee6d56c
13 changed files with 197 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+9 -9
View File
@@ -24,7 +24,7 @@ hitPointLines
hitPointLines p1 p2
= safeMinimumOn (dist p1 . fst)
. mapMaybe
(\(x,y) -> (, (x,y)) <$> intersectSegSeg' p1 p2 x y)
(\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
-- | looks for first collision of a point with walls
-- if found, gives point and reflection velocity
@@ -36,7 +36,7 @@ reflectPointWalls p1 p2 ws
fmap ( (, reflectIn (x -.- y) (p2 -.- p1))
. (+.+ errorNormalizeV 39 (vNormal (x -.- y)))
)
(intersectSegSeg' p1 p2 x y)
(intersectSegSeg p1 p2 x y)
)
. _wlLine) ws
-- | Looks for first collision of a point with walls.
@@ -52,43 +52,43 @@ reflectPointWallsDamped dfact p1 p2 ws
$ IM.mapMaybe
(( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1))
. (+.+ errorNormalizeV 40 (vNormal (x -.- y))))
(intersectSegSeg' p1 p2 x y))
(intersectSegSeg p1 p2 x y))
. _wlLine
) ws
-- | Test if a point collides with walls
pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
pointHitsWalls p1 p2
= any $ isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine
= any $ isJust . uncurry (intersectSegSeg p1 p2) . _wlLine
-- | Test if there something blocking a walk
collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
collidePointWalkable p1 p2 ws
= any (isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine)
= any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine)
$ IM.filter (fromMaybe True . (^? doorPathable)) ws
furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
furthestPointWalkable p1 p2 ws
= fromMaybe p2
. safeMinimumOn (dist p1)
$ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws
$ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
{-# INLINE collidePointIndirect #-}
collidePointIndirect p1 p2 ws
= safeMinimumOn (dist p1)
. IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine)
. IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine)
$ IM.filter (not . _wlIsSeeThrough) ws
{- | Checks to see whether someone can fire bullets effectively between two points.
- Not sure if this needs vision as well, need to make this uniform. -}
collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
collidePointFire p1 p2 ws
= safeMinimumOn (dist p1)
. IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine )
. IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine )
$ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws
{- | Checks to see whether someone can fire bullets effectively between two points.
- Not sure if this needs vision as well, need to make this uniform. -}
collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
collidePointFireVision p1 p2 ws
= any ( isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine)
= any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine)
$ IM.filter notBlockWindow ws
where
notBlockWindow wl = case wl ^? blHP of