more granular reaction
This commit is contained in:
parent
a99a70eb9d
commit
bb61df8b6d
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue