From 565a71a5a2d13583828cf478a89713f10e6645f8 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 19 May 2022 09:06:22 +0100 Subject: [PATCH] Improve creature wall collisions --- src/Dodge/WallCreatureCollisions.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index b4744579a..2c2fe083e 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -36,13 +36,14 @@ colCrWall w c where -- c'' = c' & crPos %~ pushOutFromWalls rad ls --c' = c & crPos %~ pushOutFromWalls' rad (reverse ls) - c' = c & crPos %~ pushOutFromCorners rad ls - . pushOutFromWalls rad ls + c' = c & crPos %~ pushOutFromCorners rad ls' + . pushOutFromWalls rad ls' . flip (collidePointWalls p1) wls -- check push throughs rad = _crRad c + wallBuffer p1 = _crOldPos c p2 = _crPos c ls = IM.elems $ _wlLine <$> wls + ls' = filter (uncurry $ isLHS p1) ls wls = IM.filter (not . _wlWalkable) $ wallsNearPoint p2 w --wallPoints = map fst ls @@ -59,7 +60,8 @@ pushCreatureOutFromWalls ls cr = cr & crPos %~ pushOutFromWalls (_crRad cr) ls pushOutFromWalls :: Float -> [(Point2,Point2)] -> Point2 -> Point2 pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall rad p1)) wls of Nothing -> p1 - Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall rad p2)) wls + --Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall rad p2)) wls + Just p2 -> pushOutFromWalls rad (tail wls) p2 -- possible improvement: choose between the closer of p2 and "p3" to p1 --pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2