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

Add objects based on walls, called machines

Browse Source
This commit is contained in:
justin
2021-10-31 22:55:02 +00:00
parent 08fa84c1fd
commit 86fdfd260e
23 changed files with 183 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+12 -11
View File
@@ -83,20 +83,23 @@ collideDirectionIndirect d p1 p2 wls
= fromMaybe d
$
( L.fold
. L.prefilter (not . _wlIsSeeThrough)
. L.prefilter wlIsOpaque
. L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
) L.minimum
wls
where
p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
wlIsOpaque :: Wall -> Bool
wlIsOpaque wl = _wlOpacity wl == Opaque
collidePointUpToIndirect
:: Point2 -- ^start point
-> Point2 -- ^end point
-> IM.IntMap Wall
-> Point2
{-# INLINE collidePointUpToIndirect #-}
collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter (not . _wlIsSeeThrough)
collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
where
f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
@@ -107,7 +110,7 @@ collidePointUpToIndirectMinDist
-> IM.IntMap Wall
-> Point2
{-# INLINE collidePointUpToIndirectMinDist #-}
collidePointUpToIndirectMinDist p1 p2 md = ssfold prop f p2 . IM.filter (not . _wlIsSeeThrough)
collidePointUpToIndirectMinDist p1 p2 md = ssfold prop f p2 . IM.filter wlIsOpaque
where
f x wl = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
prop p3 = dist p1 p3 < md
@@ -121,7 +124,7 @@ ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0
collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
{-# INLINE collidePointIndirect #-}
collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter (not . _wlIsSeeThrough)
collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter wlIsOpaque
where
f wl p = fromMaybe p $ uncurry (intersectSegSeg p1 p) $ _wlLine wl
test p | p == p2 = Nothing
@@ -131,7 +134,7 @@ collidePointIndirect' :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
{-# INLINE collidePointIndirect' #-}
collidePointIndirect' p1 p2
= L.fold
. L.prefilter (not . _wlIsSeeThrough)
. L.prefilter wlIsOpaque
. L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
$ L.minimumOn (dist p1)
@@ -141,17 +144,15 @@ collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
collidePointFire p1 p2 ws
= safeMinimumOn (dist p1)
. IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine )
$ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? wlBlockID))) ws
$ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) 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)
$ IM.filter notBlockWindow ws
$ IM.filter theTest ws
where
notBlockWindow wl = case wl ^? wlBlockID of
Just _ -> not $ _wlIsSeeThrough wl
Nothing -> True
theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl
-- the reason for using the dashed version is the hope that this will short
-- circuit
@@ -180,7 +181,7 @@ pathToPointFireable :: Int -> Point2 -> World -> Bool
pathToPointFireable i p w
= not
. pointHitsWalls (_crPos $ _creatures w IM.! i) p
$ IM.filter (isNothing . (^? wlBlockID) ) $ wallsAlongLine p1 p w
$ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
where
p1 = _crPos (_creatures w IM.! i)