more granular reaction

This commit is contained in:
nek0 2021-01-17 20:29:27 +01:00
parent a99a70eb9d
commit bb61df8b6d
2 changed files with 35 additions and 25 deletions

View File

@ -7,9 +7,9 @@ import Linear
import Classes.Physics.Mass import Classes.Physics.Mass
data CollisionResult a data CollisionResult time direction
= NoCollision = NoCollision
| Collision a | Collision time direction
deriving (Show, Eq) deriving (Show, Eq)
-- | Typeclass for implementing collision results on objects. -- | Typeclass for implementing collision results on objects.
@ -26,10 +26,10 @@ class (Show c, Mass c) => Collidible c where
collisionCheck collisionCheck
:: (Collidible other) :: (Collidible other)
=> Double -- ^ Time step length => Double -- ^ Time step length
-> c -- ^ First object -> c -- ^ First object
-> other -- ^ second object -> other -- ^ second object
-> CollisionResult Double -- ^ Do the objects collide? -> CollisionResult Double (V2 Int) -- ^ Do the objects collide?
collisionCheck dt m1 m2 = collisionCheck dt m1 m2 =
let d1@(V2 d1x d1y) = (dt *) <$> velocity m1 let d1@(V2 d1x d1y) = (dt *) <$> velocity m1
d2@(V2 d2x d2y) = (dt *) <$> velocity m2 d2@(V2 d2x d2y) = (dt *) <$> velocity m2
@ -69,7 +69,7 @@ class (Show c, Mass c) => Collidible c where
(0 < dm `dot` da && dm `dot` da < da `dot` da) (0 < dm `dot` da && dm `dot` da < da `dot` da)
in in
if any inside quad1 if any inside quad1
then Collision 0 then Collision 0 (V2 0 0)
else else
let res = foldl let res = foldl
(\acc1 gx -> (\acc1 gx ->
@ -81,28 +81,33 @@ class (Show c, Mass c) => Collidible c where
if (qs > 0 && qs < 1) && (qt > 0 && qt < acc2) if (qs > 0 && qs < 1) && (qt > 0 && qt < acc2)
then qt then qt
else acc2 else acc2
) )
acc1 (fst acc1)
quad1 quad1
in in
if gt < acc1 if gt < fst acc1
then gt then
( gt
, if gx == g1 || gx == g3
then V2 0 (round $ signum d1y)
else V2 (round $ signum d1x) 0
)
else acc1 else acc1
) )
dt (dt, V2 0 0)
gs gs
in in
if res < dt if fst res < dt
then Collision res then Collision `uncurry` res
else NoCollision else NoCollision
-- | This Function is called for every collision on both colliding objects. -- | This Function is called for every collision on both colliding objects.
collide collide
:: (Collidible other) :: (Collidible other)
=> c -- ^ Original object => c -- ^ Original object
-> other -- ^ Collision partner -> other -- ^ Collision partner
-> CollisionResult Double -- ^ Collision reaction -> CollisionResult Double (V2 Int) -- ^ Collision reaction
-> c -- ^ Updated original object -> c -- ^ Updated original object
collide = elasticCollision 1 collide = elasticCollision 1
-- | Implementation of a dampened elastic collision used as default collision -- | Implementation of a dampened elastic collision used as default collision
@ -112,10 +117,10 @@ elasticCollision
=> Double => Double
-> c1 -> c1
-> c2 -> c2
-> CollisionResult Double -> CollisionResult Double (V2 Int)
-> c1 -> c1
elasticCollision _ mo1 _ NoCollision = mo1 elasticCollision _ mo1 _ NoCollision = mo1
elasticCollision damping mo1 mo2 (Collision ddt) = elasticCollision damping mo1 mo2 (Collision ddt direction) =
let v1@(V2 v1x v1y) = velocity mo1 let v1@(V2 v1x v1y) = velocity mo1
(V2 v2x v2y) = velocity mo2 (V2 v2x v2y) = velocity mo2
p1@(V2 p1x p1y) = position mo1 p1@(V2 p1x p1y) = position mo1
@ -154,7 +159,7 @@ elasticCollision damping mo1 mo2 (Collision ddt) =
then 0 then 0
else -((abs m1x2 + abs m2x1) - abs dx + 1) else -((abs m1x2 + abs m2x1) - abs dx + 1)
by = if dy <= 0 by = if dy <= 0
then then
if abs dy >= abs m1y1 + abs m2y2 && if abs dy >= abs m1y1 + abs m2y2 &&
(if dx > 0 (if dx > 0
then abs dx >= abs m1x2 + abs m2x1 then abs dx >= abs m1x2 + abs m2x1

View File

@ -88,8 +88,8 @@ instance Actor Pituicat where
) )
finalCat = physCat finalCat = physCat
{ pcMoveVel = { pcMoveVel =
-- lerp (min 0.9 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat) lerp (min 0.95 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
pcTMoveVel physCat -- pcTMoveVel physCat
} }
in in
(A.log Debug ( (A.log Debug (
@ -145,14 +145,19 @@ instance Collidible Pituicat where
) )
collide cat _ NoCollision = cat collide cat _ NoCollision = cat
collide cat other collr@(Collision ddt) = collide cat other collr@(Collision ddt (V2 dirx diry)) =
A.log A.log
Debug Debug
("*boing* meow! other: " <> ("*boing* meow! other: " <>
fromString (show other)) fromString (show other))
( (
let ncat = (elasticCollision 0.3 cat other collr) let ncat = (elasticCollision 0.3 cat other collr)
(V2 dx dy) = (ddt *) <$> velocity ncat (V2 dx dy) = (ddt *) <$> (
velocity ncat *
if dirx /= 0
then V2 0 1
else V2 1 1
)
in in
ncat ncat
{ pcGrounded = abs dy < 2 { pcGrounded = abs dy < 2