Start implementing wider grenade movement
This commit is contained in:
+48
-19
@@ -33,10 +33,11 @@ module Dodge.Base.Collide (
|
||||
canSeeIndirect,
|
||||
isWalkable,
|
||||
anythingHitCirc,
|
||||
collide3WallsFloor,
|
||||
collide3,
|
||||
) where
|
||||
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
import Dodge.Data.Object
|
||||
import Control.Monad
|
||||
import Dodge.Creature.Radius
|
||||
import Control.Lens
|
||||
@@ -48,6 +49,7 @@ import Dodge.Data.World
|
||||
import Dodge.Zoning
|
||||
import FoldableHelp
|
||||
import Geometry
|
||||
import Linear.Metric
|
||||
|
||||
collidePoint :: Point2 -> Point2 -> [Wall] -> (Point2, Maybe Wall)
|
||||
{-# INLINE collidePoint #-}
|
||||
@@ -83,36 +85,63 @@ bouncePoint :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Po
|
||||
{-# INLINE bouncePoint #-}
|
||||
bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilter t sp ep
|
||||
|
||||
collide3 :: Point3 -> Point3 -> World -> (Point3, Maybe Point3)
|
||||
collide3 sp ep w = collide3Floors sp (w ^. cWorld . chasms)
|
||||
type MPO = Maybe (Point3,Object)
|
||||
|
||||
collide3WallsFloor :: Point3 -> Point3 -> World -> (Point3, MPO)
|
||||
collide3WallsFloor sp ep w = collide3Floors sp (w ^. cWorld . chasms)
|
||||
$ collide3Walls sp w (ep,Nothing)
|
||||
|
||||
-- Just (hitpoint,normaltosurface)
|
||||
collide3Walls :: Point3 -> World -> (Point3, Maybe Point3) -> (Point3, Maybe Point3)
|
||||
collide3Walls sp w (ep,mn) = collide3Part sp wsfs (ep,mn)
|
||||
collide3 :: Point3 -> Point3 -> World -> (Point3,MPO)
|
||||
collide3 sp ep w = foldl' (flip $ collide3Creature sp) (p,m)
|
||||
$ crsNearSeg (xyV3 sp) (xyV3 p) w
|
||||
where
|
||||
wsfs = f <$> wlsNearSeg (xyV3 sp) (xyV3 ep) w
|
||||
f wl = (g x, g $ vNormal (x-y), [(g x,g (y-x)),(g y,g (x-y))])
|
||||
where
|
||||
g = (`v2z` 0)
|
||||
(x,y) = _wlLine wl
|
||||
(p,m) = collide3WallsFloor sp ep w
|
||||
|
||||
collide3Floors :: Point3 -> [[Point2]] -> (Point3, Maybe Point3) -> (Point3, Maybe Point3)
|
||||
collide3Floors sp cs (ep,mn) = maybe (ep,mn) (,Just (V3 0 0 1)) mp
|
||||
-- Just (hitpoint,normaltosurface)
|
||||
collide3Walls :: Point3 -> World -> (Point3, MPO) -> (Point3, MPO)
|
||||
collide3Walls sp w ex@(ep,_) = foldl' f ex wls
|
||||
where
|
||||
f x wl = collide3Wall sp wl x
|
||||
wls = wlsNearSeg (xyV3 sp) (xyV3 ep) w
|
||||
|
||||
collide3Floors :: Point3 -> [[Point2]] -> (Point3, Maybe (Point3,Object))
|
||||
-> (Point3, Maybe (Point3,Object))
|
||||
collide3Floors sp cs (ep,mn) = maybe (ep,mn) (,Just (V3 0 0 1,OFloor)) mp
|
||||
where
|
||||
mp = do
|
||||
V3 x y z <- intersectSegPlane sp ep (V3 0 0 0) (V3 0 0 1)
|
||||
let g (a,b) = isRHS a b (V2 x y)
|
||||
f = any g
|
||||
guard (all (f . loopPairs) cs)
|
||||
return $ V3 x y z
|
||||
return $ (V3 x y z)
|
||||
|
||||
collide3Part :: Point3 -> [(Point3,Point3,[(Point3,Point3)])]
|
||||
-> (Point3, Maybe Point3)
|
||||
-> (Point3, Maybe Point3)
|
||||
collide3Part sp = flip $ foldl' findPoint
|
||||
collide3Wall :: Point3 -> Wall -> (Point3, MPO) -> (Point3, MPO)
|
||||
collide3Wall sp wl (ep,mo) = maybe (ep,mo) (,Just (n,OWall wl)) $ intersectSegSurface sp ep p n ss
|
||||
where
|
||||
findPoint (x,mn) (p,n,ss) = maybe (x,mn) (,Just n) $ intersectSegSurface sp x p n ss
|
||||
(p,n,ss) = wallToSurface wl
|
||||
|
||||
collide3Creature :: Point3 -> Creature -> (Point3, MPO) -> (Point3, MPO)
|
||||
collide3Creature sp cr (ep,m) = fromMaybe (ep,m) $ do
|
||||
(sp',ep') <- restrictSeg 0 (V3 0 0 1) (sp,ep) >>= restrictSeg (V3 0 0 25) (V3 0 0 (-1))
|
||||
p <- listToMaybe $ intersectCircSeg cpos (crRad $ cr ^. crType) (xyV3 sp') (xyV3 ep')
|
||||
let z = 0
|
||||
return (p `v2z` z,Just (normalize $ (p - cpos) `v2z` 0, OCreature cr))
|
||||
where
|
||||
cpos = cr ^. crPos
|
||||
|
||||
restrictSeg :: Point3 -> Point3 -> (Point3,Point3) -> Maybe (Point3,Point3)
|
||||
restrictSeg p n (sp,ep)
|
||||
| isNHS p n sp
|
||||
, isNHS p n ep = Just (sp,ep)
|
||||
| isNHS p n sp = (sp,) <$> intersectSegPlane sp ep p n
|
||||
| otherwise = (,ep) <$> intersectSegPlane sp ep p n
|
||||
-- note if both sp & ep are not NHS, this returns Nothing
|
||||
|
||||
wallToSurface :: Wall -> (Point3,Point3,[(Point3,Point3)])
|
||||
wallToSurface wl = (g x, g $ vNormal (x-y), [(g x,g (y-x)),(g y,g (x-y))])
|
||||
where
|
||||
g = (`v2z` 0)
|
||||
(x,y) = _wlLine wl
|
||||
|
||||
-- this COULD be written in terms of collidePointWallsFilterStream, TODO test
|
||||
-- whether this is actually faster
|
||||
|
||||
Reference in New Issue
Block a user