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

Refactor wall points from lists to pairs

Browse Source
This commit is contained in:
justin
2021-05-04 01:31:55 +02:00
parent e21178b688
commit 6d4c17fc07
23 changed files with 260 additions and 255 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WallCreatureCollisions.hs
+10 -10
View File
@@ -25,7 +25,7 @@ colCrWall w c
p1 = _crOldPos c
p2 = _crPos c
ls = IM.elems $ fmap _wlLine $ wallsNearPoint p2 w
wallPoints = nub $ concat ls
wallPoints = nub $ concatMap (\(x,y) -> [x,y]) ls
-- colCrPushThrough :: World -> Creature -> Creature
-- colCrPushThrough w cr = set crPos (checkPushThroughs rad p1 p2 ls) cr
@@ -41,7 +41,7 @@ wallBuffer = 3
-- the following tests whether or not a point is on a wall, and if so pushes it
-- out from the wall
-- this is then repeated if the point ends up on a new wall
collideWalls :: Float -> Point2 -> [[Point2]] -> Point2 -> Point2
collideWalls :: Float -> Point2 -> [(Point2,Point2)] -> Point2 -> Point2
collideWalls rad cp1 walls cp2
= case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) walls of
Nothing -> cp2
@@ -51,7 +51,7 @@ collideWalls rad cp1 walls cp2
-- pushes a point out from a list of walls
-- if multiple new points occur, chooses the one closest to the orignal point
pushOutFromWalls :: Float -> [[Point2]] -> Point2 -> Point2
pushOutFromWalls :: Float -> [(Point2,Point2)] -> Point2 -> Point2
pushOutFromWalls rad walls p =
fromMaybe p
. listToMaybe
@@ -59,7 +59,7 @@ pushOutFromWalls rad walls p =
$ mapMaybe (pushOutFromWall rad p)
walls
pushOrCrush :: [[Point2]] -> Creature -> Creature
pushOrCrush :: [(Point2,Point2)] -> Creature -> Creature
pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
[] -> cr
[p] -> cr & crPos .~ p
@@ -69,8 +69,8 @@ pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
-- assumes that the wall is orientated
-- assumes wall points are different
pushOutFromWall :: Float -> Point2 -> [Point2] -> Maybe (Point2)
pushOutFromWall rad cp2 (wp1:wp2:_)
pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe (Point2)
pushOutFromWall rad cp2 (wp1,wp2)
| isOnWall = Just newP -- +.+ (1 *.* norm))
| otherwise = Nothing
where norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
@@ -85,7 +85,7 @@ pushOutFromCorners :: World -> Creature -> Creature
pushOutFromCorners w cr = cr & crPos .~ newPos
where
newPos = foldr (intersectCirclePoint (_crRad cr)) (_crPos cr) ls
ls = nub . concat . IM.elems $ fmap _wlLine $ wallsNearPoint (_crPos cr) w
ls = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ fmap _wlLine $ wallsNearPoint (_crPos cr) w
collideCorners :: Float -> Point2 -> [Point2] -> Point2 -> Point2
collideCorners rad p1 ps p2 = foldr (intersectCirclePoint rad) p2 ps
@@ -95,12 +95,12 @@ intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
intersectCirclePoint rad p cCen | dist cCen p > rad = cCen
| otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p))
checkPushThroughs :: Float -> Point2 -> [[Point2]] -> Point2 -> Point2
checkPushThroughs :: Float -> Point2 -> [(Point2,Point2)] -> Point2 -> Point2
checkPushThroughs rad cp1 walls cp2
= fromMaybe cp2 $ (listToMaybe.mapMaybe (checkPushThrough rad cp1 cp2)) walls
checkPushThrough :: Float -> Point2 -> Point2 -> [Point2] -> Maybe (Point2)
checkPushThrough rad cp1 cp2 (wp1:wp2:_)
checkPushThrough :: Float -> Point2 -> Point2 -> (Point2,Point2) -> Maybe (Point2)
checkPushThrough rad cp1 cp2 (wp1,wp2)
| isPushedThrough = intersectSegSeg' cp1 cp2 wp1 wp2
| otherwise = Nothing
where norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)