nek0/pituicat
2
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

fix collision detection yet again

Browse source
This commit is contained in:
nek0 2021-01-19 21:46:07 +01:00
parent fe947c8ba5
commit 3d9af3eaf8
1 changed files with 24 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
src/Classes/Physics/Collidible.hs
View file

@ -1,8 +1,13 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Classes.Physics.Collidible where
import Affection as A
import Linear
import Data.String (fromString)
-- internal imports
import Classes.Physics.Mass
@ -31,8 +36,8 @@ class (Show c, Mass c) => Collidible c where
-> other -- ^ second object
-> CollisionResult Double (V2 Int) -- ^ Do the objects collide?
collisionCheck dt m1 m2 =
let d1@(V2 d1x d1y) = (dt *) <$> velocity m1
d2@(V2 d2x d2y) = (dt *) <$> velocity m2
let d1@(V2 d1x d1y) = velocity m1
d2@(V2 d2x d2y) = velocity m2
p1 = position m1
p2 = position m2
(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)
g4 = (m2p4, m2p1)
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
then dt
else
((mtpx - mqpx) * (-(mtpy - mspy)) - (-(mtpx - mspx)) * (mspy - mqpy)) /
(d1x * (-(mtpy - mspy)) - (-(mtpx - mspx)) * d1y)
s (V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) =
(d1x * (mtpy - mqpy) - (mtpx - mqpx) * d1y) /
(d1x * (-(mtpy - mspy)) - (-(mtpx - mspx)) * d1y)
let (V2 cx cy) = ps - q
(V2 rx ry) = pt - ps
in
(cx * (-ry) - (-rx) * cy) /
(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 =
let dm = m - (p2 + m2p4)
dc = (p2 + m2p3) - (p2 + m2p4)
@ -88,7 +99,8 @@ class (Show c, Mass c) => Collidible c where
if gt < fst acc1
then
( 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
else V2 0 (round $ signum d1y)
)
@ -98,7 +110,8 @@ class (Show c, Mass c) => Collidible c where
gs
in
if fst res < dt
then Collision `uncurry` res
then Collision `uncurry`
A.log Debug ("Collision Imminent!!! " <> fromString (show res)) res
else NoCollision
-- | This Function is called for every collision on both colliding objects.
@ -120,7 +133,7 @@ elasticCollision
-> CollisionResult Double (V2 Int)
-> c1
elasticCollision _ mo1 _ NoCollision = mo1
elasticCollision damping mo1 mo2 (Collision ddt direction) =
elasticCollision damping mo1 mo2 (Collision ddt _) =
let v1@(V2 v1x v1y) = velocity mo1
(V2 v2x v2y) = velocity mo2
p1@(V2 p1x p1y) = position mo1