fix collision detection yet again
This commit is contained in:
parent
fe947c8ba5
commit
3d9af3eaf8
1 changed files with 24 additions and 11 deletions
|
@ -1,8 +1,13 @@
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Classes.Physics.Collidible where
|
module Classes.Physics.Collidible where
|
||||||
|
|
||||||
|
import Affection as A
|
||||||
|
|
||||||
import Linear
|
import Linear
|
||||||
|
|
||||||
|
import Data.String (fromString)
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Classes.Physics.Mass
|
import Classes.Physics.Mass
|
||||||
|
@ -31,8 +36,8 @@ class (Show c, Mass c) => Collidible c where
|
||||||
-> other -- ^ second object
|
-> other -- ^ second object
|
||||||
-> CollisionResult Double (V2 Int) -- ^ 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) = velocity m1
|
||||||
d2@(V2 d2x d2y) = (dt *) <$> velocity m2
|
d2@(V2 d2x d2y) = velocity m2
|
||||||
p1 = position m1
|
p1 = position m1
|
||||||
p2 = position m2
|
p2 = position m2
|
||||||
(m1b1@(V2 m1b1x m1b1y), m1b2@(V2 m1b2x m1b2y)) = boundary m1
|
(m1b1@(V2 m1b1x m1b1y), m1b2@(V2 m1b2x m1b2y)) = boundary m1
|
||||||
|
@ -51,15 +56,21 @@ class (Show c, Mass c) => Collidible c where
|
||||||
g3 = (m2p3, m2p4)
|
g3 = (m2p3, m2p4)
|
||||||
g4 = (m2p4, m2p1)
|
g4 = (m2p4, m2p1)
|
||||||
gs = map (\(s1, s2) -> (p2 + s1, p2 + s2)) [g1, g2, g3, g4]
|
gs = map (\(s1, s2) -> (p2 + s1, p2 + s2)) [g1, g2, g3, g4]
|
||||||
t (V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) =
|
t q@(V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) =
|
||||||
if d1x == 0 && d1y == 0
|
if d1x == 0 && d1y == 0
|
||||||
then dt
|
then dt
|
||||||
else
|
else
|
||||||
((mtpx - mqpx) * (-(mtpy - mspy)) - (-(mtpx - mspx)) * (mspy - mqpy)) /
|
let (V2 cx cy) = ps - q
|
||||||
(d1x * (-(mtpy - mspy)) - (-(mtpx - mspx)) * d1y)
|
(V2 rx ry) = pt - ps
|
||||||
s (V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) =
|
in
|
||||||
(d1x * (mtpy - mqpy) - (mtpx - mqpx) * d1y) /
|
(cx * (-ry) - (-rx) * cy) /
|
||||||
(d1x * (-(mtpy - mspy)) - (-(mtpx - mspx)) * d1y)
|
(d1x * (-ry) - (-rx) * d1y)
|
||||||
|
s q@(V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) =
|
||||||
|
let (V2 cx cy) = ps - q
|
||||||
|
(V2 rx ry) = pt - ps
|
||||||
|
in
|
||||||
|
(d1x * cy - cx * d1y) /
|
||||||
|
(d1x * (-ry) - (-rx) * d1y)
|
||||||
inside m =
|
inside m =
|
||||||
let dm = m - (p2 + m2p4)
|
let dm = m - (p2 + m2p4)
|
||||||
dc = (p2 + m2p3) - (p2 + m2p4)
|
dc = (p2 + m2p3) - (p2 + m2p4)
|
||||||
|
@ -88,7 +99,8 @@ class (Show c, Mass c) => Collidible c where
|
||||||
if gt < fst acc1
|
if gt < fst acc1
|
||||||
then
|
then
|
||||||
( gt
|
( gt
|
||||||
, if gx == g1 || gx == g3
|
, if gx == (p2 + fst g1, p2 + snd g2) ||
|
||||||
|
gx == (p2 + fst g3, p2 + snd g3)
|
||||||
then V2 (round $ signum d1x) 0
|
then V2 (round $ signum d1x) 0
|
||||||
else V2 0 (round $ signum d1y)
|
else V2 0 (round $ signum d1y)
|
||||||
)
|
)
|
||||||
|
@ -98,7 +110,8 @@ class (Show c, Mass c) => Collidible c where
|
||||||
gs
|
gs
|
||||||
in
|
in
|
||||||
if fst res < dt
|
if fst res < dt
|
||||||
then Collision `uncurry` res
|
then Collision `uncurry`
|
||||||
|
A.log Debug ("Collision Imminent!!! " <> fromString (show res)) 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.
|
||||||
|
@ -120,7 +133,7 @@ elasticCollision
|
||||||
-> CollisionResult Double (V2 Int)
|
-> CollisionResult Double (V2 Int)
|
||||||
-> c1
|
-> c1
|
||||||
elasticCollision _ mo1 _ NoCollision = mo1
|
elasticCollision _ mo1 _ NoCollision = mo1
|
||||||
elasticCollision damping mo1 mo2 (Collision ddt direction) =
|
elasticCollision damping mo1 mo2 (Collision ddt _) =
|
||||||
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
|
||||||
|
|
Loading…
Reference in a new issue