halfway interactable objects

This commit is contained in:
nek0 2021-07-25 15:51:42 +02:00
parent 819559607c
commit 0a2e3f05d4
3 changed files with 63 additions and 17 deletions

View file

@ -8,16 +8,21 @@ import Linear
import Data.String (fromString) import Data.String (fromString)
import Data.List (sortBy)
-- internal imports -- internal imports
import Physics.Classes.Mass import Physics.Classes.Mass
data CollisionResult time direction data CollisionResult time direction
= NoCollision = NoCollision
| Collision | CollisionImminent
{ collisionTime :: time { collisionTime :: time
, collisionDirection :: direction , collisionDirection :: direction
} }
| OverlapCollision
{ collisionDepth :: direction
}
deriving (Show, Eq) deriving (Show, Eq)
-- | Typeclass for implementing collision results on objects. -- | Typeclass for implementing collision results on objects.
@ -47,13 +52,13 @@ class (Show c, Mass c) => Collidible c where
(m2b1@(V2 m2b1x m2b1y), m2b2@(V2 m2b2x m2b2y)) = boundary m2 (m2b1@(V2 m2b1x m2b1y), m2b2@(V2 m2b2x m2b2y)) = boundary m2
(V2 pm1b1x pm1b1y, V2 pm1b2x pm1b2y) = (p1 +) <$> boundary m1 (V2 pm1b1x pm1b1y, V2 pm1b2x pm1b2y) = (p1 +) <$> boundary m1
(V2 pm2b1x pm2b1y, V2 pm2b2x pm2b2y) = (p2 +) <$> boundary m2 (V2 pm2b1x pm2b1y, V2 pm2b2x pm2b2y) = (p2 +) <$> boundary m2
m1p1 = p1 + m1b1 m1p1@(V2 m1p1x m1p1y) = p1 + m1b1
m1p2 = p1 + V2 m1b1x m1b2y m1p2 = p1 + V2 m1b1x m1b2y
m1p3 = p1 + m1b2 m1p3@(V2 m1p3x m1p3y) = p1 + m1b2
m1p4@(V2 m1p4x _) = p1 + V2 m1b2x m1b1y m1p4@(V2 m1p4x _) = p1 + V2 m1b2x m1b1y
m2p1@(V2 m2p1x _) = p2 + m2b1 m2p1@(V2 m2p1x m2p1y) = p2 + m2b1
m2p2 = p2 + V2 m2b1x m2b2y m2p2 = p2 + V2 m2b1x m2b2y
m2p3 = p2 + m2b2 m2p3@(V2 m2p3x m2p3y) = p2 + m2b2
m2p4 = p2 + V2 m2b2x m2b1y m2p4 = p2 + V2 m2b2x m2b1y
(V2 b1minx b1miny, V2 b1maxx b1maxy) = (V2 b1minx b1miny, V2 b1maxx b1maxy) =
( V2 ( V2
@ -154,13 +159,13 @@ class (Show c, Mass c) => Collidible c where
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22] any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of
(True, _, True, True, _) -> (True, _, True, True, _) ->
Collision tx (V2 (floor $ signum d1x) 0) CollisionImminent tx (V2 (floor $ signum d1x) 0)
(_, True, False, _, True) -> (_, True, False, _, True) ->
Collision ty (V2 0 (floor $ signum d1y)) CollisionImminent ty (V2 0 (floor $ signum d1y))
(True, _, False, True, False) -> (True, _, False, True, False) ->
Collision tx (V2 (floor $ signum d1x) 0) CollisionImminent tx (V2 (floor $ signum d1x) 0)
(_, True, True, False, True) -> (_, True, True, False, True) ->
Collision ty (V2 0 (floor $ signum d1y)) CollisionImminent ty (V2 0 (floor $ signum d1y))
(_, _, _, False, False) -> (_, _, _, False, False) ->
NoCollision NoCollision
(_, _, True, _, _) -> (_, _, True, _, _) ->
@ -172,12 +177,37 @@ class (Show c, Mass c) => Collidible c where
<> fromString (show x) <> fromString (show x)
in in
case res of case res of
Collision _ _ -> CollisionImminent _ _ ->
res res
NoCollision -> NoCollision ->
if overlap if overlap
then Collision 0 (V2 0 0) then
let xoverlap = floor (minimum
[ pm2b2x - pm2b1x
, pm2b1x - pm1b2x
])
yoverlap = floor (minimum
[ pm2b1y - pm1b2y
, pm2b2y - pm1b1y
])
in
if xoverlap < yoverlap
then
if xoverlap < 0
then OverlapCollision
(V2 xoverlap 0)
else
NoCollision
else
if yoverlap < 0
then OverlapCollision
(V2 yoverlap 0)
else NoCollision
else NoCollision else NoCollision
_ -> A.log
A.Error
"Premature overlap collision detection"
NoCollision
else else
NoCollision NoCollision
@ -200,7 +230,7 @@ elasticCollision
-> Double -- ^ Timestep length -> Double -- ^ Timestep length
-> c1 -> c1
elasticCollision _ mo1 (_, NoCollision) _ = mo1 elasticCollision _ mo1 (_, NoCollision) _ = mo1
elasticCollision damping mo1 (mo2, Collision ddt (V2 dirx diry)) dt = elasticCollision damping mo1 (mo2, CollisionImminent ddt (V2 dirx diry)) dt =
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 = position mo1 p1 = position mo1
@ -221,3 +251,14 @@ elasticCollision damping mo1 (mo2, Collision ddt (V2 dirx diry)) dt =
velocityUpdater velocityUpdater
mo1 mo1
nvel nvel
elasticCollision damping mo1 (mo2, OverlapCollision depth) dt =
let m1 = mass mo1
m2 = mass mo2
(V2 dx dy) = (/ dt) . fromIntegral <$> depth
v1x' = 2 * (m1 * dx + m2 * (-dx)) / (m1 + m2) - dx
v1y' = 2 * (m1 * dy + m2 * (-dy)) / (m1 + m2) - dy
nvel = if m1 == recip 0
then V2 0 0
else (damping *) <$> V2 v1x' v1y'
in
velocityUpdater mo1 nvel

View file

@ -57,9 +57,12 @@ update level dt = liftIO $ do
(\jacc (qInd, tangible2) -> (\jacc (qInd, tangible2) ->
let res = collisionCheck dt tangible1 tangible2 let res = collisionCheck dt tangible1 tangible2
in in
if res /= NoCollision && qInd /= index case res of
then jacc `V.snoc` (qInd, res) c@(CollisionImminent _ _) ->
else jacc if qInd /= index
then jacc `V.snoc` (qInd, c)
else jacc
_ -> jacc
) )
V.empty V.empty
indexedTangibles indexedTangibles

View file

@ -196,10 +196,12 @@ instance Collidible Pituicat where
} }
collide cat collrs@((_, NoCollision):_) _ = cat collide cat collrs@((_, NoCollision):_) _ = cat
{ pcXColl = any { pcXColl = any
(\(_, Collision _ (V2 cx _)) -> cx /= 0) (\(_, CollisionImminent _ (V2 cx _)) -> cx /= 0)
(filter ((NoCollision /= ) . snd) collrs) (filter ((NoCollision /= ) . snd) collrs)
} }
collide cat collrs@(collr@((other, Collision ddt (V2 dirx diry))):_) dt = collide cat collrs@(collr@(_, OverlapCollision direction):_) dt =
elasticCollision 0.3 cat collr dt
collide cat collrs@(collr@(other, CollisionImminent ddt (V2 dirx diry)):_) dt =
let ncat = elasticCollision 0.3 cat collr dt let ncat = elasticCollision 0.3 cat collr dt
vel@(V2 vx vy) = velocity ncat vel@(V2 vx vy) = velocity ncat
moveVel@(V2 mx my) = pcMoveVel cat moveVel@(V2 mx my) = pcMoveVel cat