|
|
|
@ -8,6 +8,8 @@ import Linear
|
|
|
|
|
|
|
|
|
|
import Data.String (fromString) |
|
|
|
|
|
|
|
|
|
import Data.List (minimumBy) |
|
|
|
|
|
|
|
|
|
-- internal imports |
|
|
|
|
|
|
|
|
|
import Classes.Physics.Mass |
|
|
|
@ -51,12 +53,18 @@ class (Show c, Mass c) => Collidible c where
|
|
|
|
|
m2p3 = m2b2 |
|
|
|
|
m2p4 = V2 m2b2x m2b1y |
|
|
|
|
quad1 = map (p1 +) [m1p1, m1p2, m1p3, m1p4] |
|
|
|
|
g1 = (m2p1, m2p2) |
|
|
|
|
g2 = (m2p2, m2p3) |
|
|
|
|
g3 = (m2p3, m2p4) |
|
|
|
|
g4 = (m2p4, m2p1) |
|
|
|
|
gs = map (\(s1, s2) -> (p2 + s1, p2 + s2)) [g1, g2, g3, g4] |
|
|
|
|
t q@(V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) = |
|
|
|
|
quad2 = map (p2 +) [m2p1, m2p2, m2p3, m2p4] |
|
|
|
|
g11 = (m1p1, m1p2) |
|
|
|
|
g12 = (m1p2, m1p3) |
|
|
|
|
g13 = (m1p3, m1p4) |
|
|
|
|
g14 = (m1p4, m1p1) |
|
|
|
|
g21 = (m2p1, m2p2) |
|
|
|
|
g22 = (m2p2, m2p3) |
|
|
|
|
g23 = (m2p3, m2p4) |
|
|
|
|
g24 = (m2p4, m2p1) |
|
|
|
|
g1s = map (\(s1, s2) -> (p1 + s1, p1 + s2)) [g11, g12, g13, g14] |
|
|
|
|
g2s = map (\(s1, s2) -> (p2 + s1, p2 + s2)) [g21, g22, g23, g24] |
|
|
|
|
t1 q@(V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) = |
|
|
|
|
if d1x == 0 && d1y == 0 |
|
|
|
|
then dt |
|
|
|
|
else |
|
|
|
@ -65,13 +73,35 @@ class (Show c, Mass c) => Collidible c where
|
|
|
|
|
in |
|
|
|
|
(cx * (-ry) - (-rx) * cy) / |
|
|
|
|
(d1x * (-ry) - (-rx) * d1y) |
|
|
|
|
s q@(V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) = |
|
|
|
|
t2 q@(V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) = |
|
|
|
|
if d2x == 0 && d2y == 0 |
|
|
|
|
then dt |
|
|
|
|
else |
|
|
|
|
let (V2 cx cy) = ps - q |
|
|
|
|
(V2 rx ry) = pt - ps |
|
|
|
|
in |
|
|
|
|
(cx * (-ry) - (-rx) * cy) / |
|
|
|
|
(d2x * (-ry) - (-rx) * d2y) |
|
|
|
|
s1 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 = |
|
|
|
|
s2 q@(V2 mqpx mqpy) (ps@(V2 mspx mspy), pt@(V2 mtpx mtpy)) = |
|
|
|
|
let (V2 cx cy) = ps - q |
|
|
|
|
(V2 rx ry) = pt - ps |
|
|
|
|
in |
|
|
|
|
(d2x * cy - cx * d2y) / |
|
|
|
|
(d2x * (-ry) - (-rx) * d2y) |
|
|
|
|
inside1 m = |
|
|
|
|
let dm = m - (p1 + m1p4) |
|
|
|
|
dc = (p1 + m1p3) - (p1 + m1p4) |
|
|
|
|
da = (p1 + m1p1) - (p1 + m1p4) |
|
|
|
|
in |
|
|
|
|
(0 < dm `dot` dc && dm `dot` dc < dc `dot` dc) && |
|
|
|
|
(0 < dm `dot` da && dm `dot` da < da `dot` da) |
|
|
|
|
inside2 m = |
|
|
|
|
let dm = m - (p2 + m2p4) |
|
|
|
|
dc = (p2 + m2p3) - (p2 + m2p4) |
|
|
|
|
da = (p2 + m2p1) - (p2 + m2p4) |
|
|
|
@ -79,19 +109,45 @@ class (Show c, Mass c) => Collidible c where
|
|
|
|
|
(0 < dm `dot` dc && dm `dot` dc < dc `dot` dc) && |
|
|
|
|
(0 < dm `dot` da && dm `dot` da < da `dot` da) |
|
|
|
|
in |
|
|
|
|
if any inside quad1 |
|
|
|
|
if any inside1 quad2 || any inside2 quad1 |
|
|
|
|
then Collision 0 |
|
|
|
|
(if abs d1x > abs d1y |
|
|
|
|
then V2 (round $ signum d1x) 0 |
|
|
|
|
else V2 0 (round $ signum d1y) |
|
|
|
|
) |
|
|
|
|
else |
|
|
|
|
let res = foldl |
|
|
|
|
let res1 = foldl |
|
|
|
|
(\acc1 gx -> |
|
|
|
|
let gt = foldl |
|
|
|
|
(\acc2 q -> |
|
|
|
|
let qt = t1 q gx |
|
|
|
|
qs = s1 q gx |
|
|
|
|
in |
|
|
|
|
if (qs > 0 && qs < 1) && (qt > 0 && qt < acc2) |
|
|
|
|
then qt |
|
|
|
|
else acc2 |
|
|
|
|
) |
|
|
|
|
(fst acc1) |
|
|
|
|
quad1 |
|
|
|
|
in |
|
|
|
|
if gt < fst acc1 |
|
|
|
|
then |
|
|
|
|
( gt |
|
|
|
|
, if gx == (p2 + fst g21, p2 + snd g22) || |
|
|
|
|
gx == (p2 + fst g23, p2 + snd g23) |
|
|
|
|
then V2 (round $ signum d1x) 0 |
|
|
|
|
else V2 0 (round $ signum d1y) |
|
|
|
|
) |
|
|
|
|
else acc1 |
|
|
|
|
) |
|
|
|
|
(dt, V2 0 0) |
|
|
|
|
g2s |
|
|
|
|
res2 = foldl |
|
|
|
|
(\acc1 gx -> |
|
|
|
|
let gt = foldl |
|
|
|
|
(\acc2 q -> |
|
|
|
|
let qt = t q gx |
|
|
|
|
qs = s q gx |
|
|
|
|
let qt = t2 q gx |
|
|
|
|
qs = s2 q gx |
|
|
|
|
in |
|
|
|
|
if (qs > 0 && qs < 1) && (qt > 0 && qt < acc2) |
|
|
|
|
then qt |
|
|
|
@ -103,15 +159,16 @@ class (Show c, Mass c) => Collidible c where
|
|
|
|
|
if gt < fst acc1 |
|
|
|
|
then |
|
|
|
|
( gt |
|
|
|
|
, if gx == (p2 + fst g1, p2 + snd g2) || |
|
|
|
|
gx == (p2 + fst g3, p2 + snd g3) |
|
|
|
|
, if gx == (p1 + fst g11, p2 + snd g12) || |
|
|
|
|
gx == (p1 + fst g13, p2 + snd g13) |
|
|
|
|
then V2 (round $ signum d1x) 0 |
|
|
|
|
else V2 0 (round $ signum d1y) |
|
|
|
|
) |
|
|
|
|
else acc1 |
|
|
|
|
) |
|
|
|
|
(dt, V2 0 0) |
|
|
|
|
gs |
|
|
|
|
g1s |
|
|
|
|
res = minimumBy (\a b -> fst a `compare` fst b) [res1, res2] |
|
|
|
|
in |
|
|
|
|
if fst res < dt |
|
|
|
|
then Collision `uncurry` |
|
|
|
@ -198,7 +255,7 @@ elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx diry)) =
|
|
|
|
|
(p1 + |
|
|
|
|
if ddt == 0 |
|
|
|
|
then |
|
|
|
|
if diry == 0 |
|
|
|
|
if abs bx < abs by |
|
|
|
|
then |
|
|
|
|
V2 bx 0 |
|
|
|
|
else |
|
|
|
|