switch to deltatime-based collision detection to prevent tunneling
This commit is contained in:
parent
8e870e3525
commit
b043ff7707
|
@ -21,27 +21,43 @@ class (Show c, Mass c) => Collidible c where
|
||||||
|
|
||||||
collisionCheck
|
collisionCheck
|
||||||
:: (Collidible other)
|
:: (Collidible other)
|
||||||
=> c -- ^ First object
|
=> Double -- Time step length
|
||||||
-> other -- ^ second object
|
-> c -- ^ First object
|
||||||
-> Bool -- ^ Do the objects collide?
|
-> other -- ^ second object
|
||||||
collisionCheck m1 m2 =
|
-> Bool -- ^ Do the objects collide?
|
||||||
let (V2 m1x1 m1y1) = position m1 + fst (boundary m1)
|
collisionCheck dt m1 m2 =
|
||||||
(V2 m1x2 m1y2) = position m1 + snd (boundary m1)
|
let (V2 m1x1 m1y1) = position m1 + fst (boundary m1) + delta1
|
||||||
(V2 m2x1 m2y1) = position m2 + fst (boundary m2)
|
(V2 m1x2 m1y2) = position m1 + snd (boundary m1) + delta1
|
||||||
(V2 m2x2 m2y2) = position m2 + snd (boundary m2)
|
(V2 m2x1 m2y1) = position m2 + fst (boundary m2) + delta2
|
||||||
|
(V2 m2x2 m2y2) = position m2 + snd (boundary m2) + delta2
|
||||||
|
delta1@(V2 vx1 vy1) = (dt *) <$> velocity m1
|
||||||
|
delta2@(V2 vx2 vy2) = (dt *) <$> velocity m2
|
||||||
|
dtx 0 = dt
|
||||||
|
dtx vx =
|
||||||
|
if vx1 > 0
|
||||||
|
then (m2x1 - m1x2) / vx
|
||||||
|
else (m1x1 - m2x2) / (-vx)
|
||||||
|
dty 0 = dt
|
||||||
|
dty vy =
|
||||||
|
if vy1 > 0
|
||||||
|
then (m2y1 - m1y2) / vy
|
||||||
|
else (m1y1 - m2y2) / (-vy)
|
||||||
|
posColl =
|
||||||
|
or
|
||||||
|
[ m1x1 < m2x2 && m1x1 > m2x1
|
||||||
|
, m1x2 < m2x2 && m1x2 > m2x1
|
||||||
|
, m2x1 < m1x2 && m2x1 > m1x1
|
||||||
|
, m2x2 < m1x2 && m2x2 > m1x1
|
||||||
|
] && or
|
||||||
|
[ m1y1 < m2y2 && m1y1 > m2y1
|
||||||
|
, m1y2 < m2y2 && m1y2 > m2y1
|
||||||
|
, m2y1 < m1y2 && m2y1 > m1y1
|
||||||
|
, m2y2 < m1y2 && m2y2 > m1y1
|
||||||
|
]
|
||||||
in
|
in
|
||||||
or
|
(if vx1 == 0 then posColl else dt > dtx vx1)
|
||||||
[ m1x1 < m2x2 && m1x1 > m2x1
|
&&
|
||||||
, m1x2 < m2x2 && m1x2 > m2x1
|
(if vy1 == 0 then posColl else dt > dty vy1)
|
||||||
, m2x1 < m1x2 && m2x1 > m1x1
|
|
||||||
, m2x2 < m1x2 && m2x2 > m1x1
|
|
||||||
] && or
|
|
||||||
[ m1y1 < m2y2 && m1y1 > m2y1
|
|
||||||
, m1y2 < m2y2 && m1y2 > m2y1
|
|
||||||
, m2y1 < m1y2 && m2y1 > m1y1
|
|
||||||
, m2y2 < m1y2 && m2y2 > m1y1
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
-- | This Function is called for every collision on both colliding objects.
|
-- | This Function is called for every collision on both colliding objects.
|
||||||
collide
|
collide
|
||||||
|
|
|
@ -153,7 +153,7 @@ instance Scene Test where
|
||||||
collidedCast =
|
collidedCast =
|
||||||
(\(Cast c1) (Cast c2) ->
|
(\(Cast c1) (Cast c2) ->
|
||||||
Cast $
|
Cast $
|
||||||
if collisionCheck c1 c2
|
if collisionCheck dt c1 c2
|
||||||
then collide c1 c2
|
then collide c1 c2
|
||||||
else c1
|
else c1
|
||||||
)
|
)
|
||||||
|
@ -161,7 +161,7 @@ instance Scene Test where
|
||||||
wallCast (Cast c) = Cast $
|
wallCast (Cast c) = Cast $
|
||||||
V.foldl
|
V.foldl
|
||||||
(\member tile ->
|
(\member tile ->
|
||||||
if collisionCheck member tile
|
if collisionCheck dt member tile
|
||||||
then collide member tile
|
then collide member tile
|
||||||
else member
|
else member
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in a new issue