halfway interactable objects
This commit is contained in:
parent
819559607c
commit
0a2e3f05d4
3 changed files with 63 additions and 17 deletions
|
|
@ -8,16 +8,21 @@ import Linear
|
|||
|
||||
import Data.String (fromString)
|
||||
|
||||
import Data.List (sortBy)
|
||||
|
||||
-- internal imports
|
||||
|
||||
import Physics.Classes.Mass
|
||||
|
||||
data CollisionResult time direction
|
||||
= NoCollision
|
||||
| Collision
|
||||
| CollisionImminent
|
||||
{ collisionTime :: time
|
||||
, collisionDirection :: direction
|
||||
}
|
||||
| OverlapCollision
|
||||
{ collisionDepth :: direction
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 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
|
||||
(V2 pm1b1x pm1b1y, V2 pm1b2x pm1b2y) = (p1 +) <$> boundary m1
|
||||
(V2 pm2b1x pm2b1y, V2 pm2b2x pm2b2y) = (p2 +) <$> boundary m2
|
||||
m1p1 = p1 + m1b1
|
||||
m1p1@(V2 m1p1x m1p1y) = p1 + m1b1
|
||||
m1p2 = p1 + V2 m1b1x m1b2y
|
||||
m1p3 = p1 + m1b2
|
||||
m1p3@(V2 m1p3x m1p3y) = p1 + m1b2
|
||||
m1p4@(V2 m1p4x _) = p1 + V2 m1b2x m1b1y
|
||||
m2p1@(V2 m2p1x _) = p2 + m2b1
|
||||
m2p1@(V2 m2p1x m2p1y) = p2 + m2b1
|
||||
m2p2 = p2 + V2 m2b1x m2b2y
|
||||
m2p3 = p2 + m2b2
|
||||
m2p3@(V2 m2p3x m2p3y) = p2 + m2b2
|
||||
m2p4 = p2 + V2 m2b2x m2b1y
|
||||
(V2 b1minx b1miny, V2 b1maxx b1maxy) =
|
||||
( V2
|
||||
|
|
@ -154,13 +159,13 @@ class (Show c, Mass c) => Collidible c where
|
|||
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
|
||||
res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of
|
||||
(True, _, True, True, _) ->
|
||||
Collision tx (V2 (floor $ signum d1x) 0)
|
||||
CollisionImminent tx (V2 (floor $ signum d1x) 0)
|
||||
(_, True, False, _, True) ->
|
||||
Collision ty (V2 0 (floor $ signum d1y))
|
||||
CollisionImminent ty (V2 0 (floor $ signum d1y))
|
||||
(True, _, False, True, False) ->
|
||||
Collision tx (V2 (floor $ signum d1x) 0)
|
||||
CollisionImminent tx (V2 (floor $ signum d1x) 0)
|
||||
(_, True, True, False, True) ->
|
||||
Collision ty (V2 0 (floor $ signum d1y))
|
||||
CollisionImminent ty (V2 0 (floor $ signum d1y))
|
||||
(_, _, _, False, False) ->
|
||||
NoCollision
|
||||
(_, _, True, _, _) ->
|
||||
|
|
@ -172,12 +177,37 @@ class (Show c, Mass c) => Collidible c where
|
|||
<> fromString (show x)
|
||||
in
|
||||
case res of
|
||||
Collision _ _ ->
|
||||
CollisionImminent _ _ ->
|
||||
res
|
||||
NoCollision ->
|
||||
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
|
||||
_ -> A.log
|
||||
A.Error
|
||||
"Premature overlap collision detection"
|
||||
NoCollision
|
||||
else
|
||||
NoCollision
|
||||
|
||||
|
|
@ -200,7 +230,7 @@ elasticCollision
|
|||
-> Double -- ^ Timestep length
|
||||
-> c1
|
||||
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
|
||||
(V2 v2x v2y) = velocity mo2
|
||||
p1 = position mo1
|
||||
|
|
@ -221,3 +251,14 @@ elasticCollision damping mo1 (mo2, Collision ddt (V2 dirx diry)) dt =
|
|||
velocityUpdater
|
||||
mo1
|
||||
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
|
||||
|
|
|
|||
|
|
@ -57,9 +57,12 @@ update level dt = liftIO $ do
|
|||
(\jacc (qInd, tangible2) ->
|
||||
let res = collisionCheck dt tangible1 tangible2
|
||||
in
|
||||
if res /= NoCollision && qInd /= index
|
||||
then jacc `V.snoc` (qInd, res)
|
||||
case res of
|
||||
c@(CollisionImminent _ _) ->
|
||||
if qInd /= index
|
||||
then jacc `V.snoc` (qInd, c)
|
||||
else jacc
|
||||
_ -> jacc
|
||||
)
|
||||
V.empty
|
||||
indexedTangibles
|
||||
|
|
|
|||
|
|
@ -196,10 +196,12 @@ instance Collidible Pituicat where
|
|||
}
|
||||
collide cat collrs@((_, NoCollision):_) _ = cat
|
||||
{ pcXColl = any
|
||||
(\(_, Collision _ (V2 cx _)) -> cx /= 0)
|
||||
(\(_, CollisionImminent _ (V2 cx _)) -> cx /= 0)
|
||||
(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
|
||||
vel@(V2 vx vy) = velocity ncat
|
||||
moveVel@(V2 mx my) = pcMoveVel cat
|
||||
|
|
|
|||
Loading…
Reference in a new issue