deduplication

movable_objects2
nek0 1 year ago
parent 7657a35415
commit 9a9408edf3
  1. 51
      src/Classes/Physics/Collidible.hs

@ -103,42 +103,34 @@ class (Show c, Mass c) => Collidible c where
in
if broadphaseOverlap
then
let collx =
let coll xdir =
let (p11, p12, p21, p22) =
if d1x < 0
if xdir
then
(m1p1, m1p2, m2p4, m2p3)
if d1x < 0
then
(m1p1, m1p2, m2p4, m2p3)
else
(m1p4, m1p3, m2p1, m2p2)
else
(m1p4, m1p3, m2p1, m2p2)
(V2 _ g1s) = p11 + ((tx *) <$> d1)
(V2 _ g1e) = p12 + ((tx *) <$> d1)
(V2 _ g2s) = p21 + ((tx *) <$> d2)
(V2 _ g2e) = p22 + ((tx *) <$> d2)
if d1y < 0
then
(m1p1, m1p4, m2p2, m2p3)
else
(m1p2, m1p3, m2p1, m2p4)
vselector (V2 x y) = if xdir then y else x
tick = if xdir then tx else ty
g1s = vselector $ p11 + ((tick *) <$> d1)
g1e = vselector $ p12 + ((tick *) <$> d1)
g2s = vselector $ p21 + ((tick *) <$> d2)
g2e = vselector $ p22 + ((tick *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
colly =
let (p11, p12, p21, p22) =
if d1y < 0
then
(m1p1, m1p4, m2p2, m2p3)
else
(m1p2, m1p3, m2p1, m2p4)
(V2 g1s _) = p11 + ((ty *) <$> d1)
(V2 g1e _) = p12 + ((ty *) <$> d1)
(V2 g2s _) = p21 + ((ty *) <$> d2)
(V2 g2e _) = p22 + ((ty *) <$> d2)
s11 = (g1s - g2s) / (g2e - g2s)
s12 = (g1e - g2s) / (g2e - g2s)
s21 = (g2s - g1s) / (g1e - g1s)
s22 = (g2e - g1s) / (g1e - g1s)
in
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
res =
case (tx < dt, ty < dt, tx < ty, collx, colly) of
res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of
(True, _, True, True, _) ->
Collision tx (V2 (floor $ signum d1x) 0)
(_, True, False, _, True) ->
@ -150,10 +142,9 @@ class (Show c, Mass c) => Collidible c where
(_, _, _, False, False) ->
NoCollision
in
A.log
A.Debug
A.log A.Debug
(fromString $
show (tx < dt, ty < dt, tx < ty, collx, colly))
show (tx < dt, ty < dt, tx < ty, coll True, coll False))
res
else
NoCollision

Loading…
Cancel
Save