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

Delete cruft, add Reader monad to some internal ai

Browse Source
This commit is contained in:
jgk
2021-05-16 21:42:11 +02:00
parent 0798cc0b0e
commit d7fcdbf550
69 changed files with 721 additions and 2894 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WallCreatureCollisions.hs
+5 -5
View File
@@ -27,7 +27,7 @@ colCrWall w c
rad = _crRad c + wallBuffer
p1 = _crOldPos c
p2 = _crPos c
ls = IM.elems $ fmap _wlLine $ wallsNearPoint p2 w
ls = IM.elems $ _wlLine <$> wallsNearPoint p2 w
wallPoints = nub $ concatMap (\(x,y) -> [x,y]) ls
-- colCrPushThrough :: World -> Creature -> Creature
@@ -65,13 +65,13 @@ pushOrCrush :: [(Point2,Point2)] -> Creature -> Creature
pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
[] -> cr
[p] -> cr & crPos .~ p
_ -> cr & crState . crDamage %~ ( (Blunt 50 cpos cpos cpos) :)
_ -> cr & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : )
where
cpos = _crPos cr
-- assumes that the wall is orientated
-- assumes wall points are different
pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe (Point2)
pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
pushOutFromWall rad cp2 (wp1,wp2)
| isOnWall = Just newP -- +.+ (1 *.* norm))
| otherwise = Nothing
@@ -88,7 +88,7 @@ pushOutFromCorners :: World -> Creature -> Creature
pushOutFromCorners w cr = cr & crPos .~ newPos
where
newPos = foldr (intersectCirclePoint (_crRad cr)) (_crPos cr) ls
ls = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ fmap _wlLine $ wallsNearPoint (_crPos cr) w
ls = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ _wlLine <$> wallsNearPoint (_crPos cr) w
collideCorners :: Float -> Point2 -> [Point2] -> Point2 -> Point2
collideCorners rad p1 ps p2 = foldr (intersectCirclePoint rad) p2 ps
@@ -103,7 +103,7 @@ 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,Point2) -> Maybe (Point2)
checkPushThrough :: Float -> Point2 -> Point2 -> (Point2,Point2) -> Maybe Point2
checkPushThrough rad cp1 cp2 (wp1,wp2)
| isPushedThrough = intersectSegSeg' cp1 cp2 wp1 wp2
| otherwise = Nothing