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/Base/Collide.hs
+13 -18
View File
@@ -13,9 +13,7 @@ import Control.Lens
hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-}
hasLOS p1 p2 w = (not $ pointHitsWalls p1 p2 nearbyWalls)
where
nearbyWalls = wallsAlongLine p1 p2 w
hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w
-- | looks for first collision of a point with walls
-- if found, gives point and reflection velocity
reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
@@ -56,11 +54,11 @@ reflectPointWallsDamped dfact p1 p2 ws
-- | Test if a point collides with walls
pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
pointHitsWalls p1 p2
= any $ isJust . ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _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 . ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine)
= any (isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine)
$ IM.filter (fromMaybe True . (^? doorPathable)) ws
furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
@@ -69,7 +67,7 @@ furthestPointWalkable p1 p2 ws
. listToMaybe
. sortOn (dist p1)
. IM.elems
$ IM.mapMaybe ( ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine) ws
$ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws
collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
{-# INLINE collidePointIndirect #-}
@@ -77,7 +75,7 @@ collidePointIndirect p1 p2 ws
= listToMaybe
. sortOn (dist p1)
. IM.elems
. IM.mapMaybe ( ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _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. -}
@@ -86,13 +84,13 @@ collidePointFire p1 p2 ws
= listToMaybe
. sortOn (dist p1)
. IM.elems
. IM.mapMaybe ( ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _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 . ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine)
= any ( isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine)
$ IM.filter notBlockWindow ws
where
notBlockWindow wl = case wl ^? blHP of
@@ -125,15 +123,14 @@ canSeePoint i p w = hasLOS p1 p w
pathToPointFireable :: Int -> Point2 -> World -> Bool
pathToPointFireable i p w
= not
. pointHitsWalls (_crPos (_creatures w IM.! i)) p
$ IM.filter (not . isJust . \wl -> wl ^? blHP) $ wallsAlongLine p1 p w
. pointHitsWalls (_crPos $ _creatures w IM.! i) p
$ IM.filter (isNothing . (^? blHP) ) $ wallsAlongLine p1 p w
where
p1 = _crPos (_creatures w IM.! i)
canSeePointAll :: Int -> Point2 -> World -> Bool
canSeePointAll i targPos w
= and
$ map (flip (canSeePoint i) w . (\p -> (targPos +.+ radius *.* p))) [(1,0),(0,1),(-1,0),(0,-1)]
= all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
where
cr = _creatures w IM.! i
cpos = _crPos cr
@@ -141,8 +138,7 @@ canSeePointAll i targPos w
canSeeAny :: Int -> Int -> World -> Bool
canSeeAny fromID toID w
= or
$ map (flip (canSeePoint fromID) w . (\p -> (cpos +.+ radius *.* p))) [(1,0),(0,1),(-1,0),(0,-1)]
= any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
where
cr = _creatures w IM.! toID
cpos = _crPos cr
@@ -150,8 +146,7 @@ canSeeAny fromID toID w
canSeeAll :: Int -> Int -> World -> Bool
canSeeAll fromID toID w
= and
$ map (flip (canSeePoint fromID) w . (\p -> (cpos +.+ radius *.* p))) [(1,0),(0,1),(-1,0),(0,-1)]
= all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
where
cr = _creatures w IM.! toID
cpos = _crPos cr
@@ -164,7 +159,7 @@ canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos
jpos = _crPos (_creatures w IM.! j)
canSeeIndirect :: Int -> Int -> World -> Bool
canSeeIndirect i j w = not . isJust . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
where
ipos = _crPos (_creatures w IM.! i)
jpos = _crPos (_creatures w IM.! j)