diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index 7bb8fb1..c2672d4 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Classes/Physics/Collidible.hs @@ -119,71 +119,70 @@ class (Show c, Mass c) => Collidible c where in if broadphaseOverlap then - if tx <= ty - then - if tx < dt - then - if d1x <= 0 - then - let (V2 _ g1s) = m1p1 + ((tx *) <$> d1) - (V2 _ g1e) = m1p2 + ((tx *) <$> d1) - (V2 _ g2s) = m2p4 + ((tx *) <$> d2) - (V2 _ g2e) = m2p3 + ((tx *) <$> d2) - s11 = (g1s - g2s) / (g2e - g2s) - s12 = (g1e - g2s) / (g2e - g2s) - s21 = (g2s - g1s) / (g1e - g1s) - s22 = (g2e - g1s) / (g1e - g1s) - in - if any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22] - then Collision tx (V2 (floor $ signum d1x) 0) - else NoCollision - else - let (V2 _ g1s) = m1p4 + ((tx *) <$> d1) - (V2 _ g1e) = m1p3 + ((tx *) <$> d1) - (V2 _ g2s) = m2p1 + ((tx *) <$> d2) - (V2 _ g2e) = m2p2 + ((tx *) <$> d2) - s11 = (g1s - g2s) / (g2e - g2s) - s12 = (g1e - g2s) / (g2e - g2s) - s21 = (g2s - g1s) / (g1e - g1s) - s22 = (g2e - g1s) / (g1e - g1s) - in - if any (\x -> x > 0 && x < 1) ((\s ->A.log A.Debug ("s: " <> fromString (show s)) s) [s11, s12, s21 ,s22]) - then Collision tx (V2 (floor $ signum d1x) 0) - else NoCollision - else - NoCollision - else - if ty < dt - then - if d1y <= 0 - then - let (V2 g1s _) = m1p1 + ((ty *) <$> d1) - (V2 g1e _) = m1p4 + ((ty *) <$> d1) - (V2 g2s _) = m2p2 + ((ty *) <$> d2) - (V2 g2e _) = m2p3 + ((ty *) <$> d2) - s11 = (g1s - g2s) / (g2e - g2s) - s12 = (g1e - g2s) / (g2e - g2s) - s21 = (g2s - g1s) / (g1e - g1s) - s22 = (g2e - g1s) / (g1e - g1s) - in - if any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22] - then Collision ty (V2 0 (floor $ signum d1y)) - else NoCollision - else - let (V2 g1s _) = m1p2 + ((ty *) <$> d1) - (V2 g1e _) = m1p3 + ((ty *) <$> d1) - (V2 g2s _) = m2p1 + ((ty *) <$> d2) - (V2 g2e _) = m2p4 + ((ty *) <$> d2) - s11 = (g1s - g2s) / (g2e - g2s) - s12 = (g1e - g2s) / (g2e - g2s) - s21 = (g2s - g1s) / (g1e - g1s) - s22 = (g2e - g1s) / (g1e - g1s) - in - if any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22] - then Collision ty (V2 0 (floor $ signum d1y)) - else NoCollision - else - NoCollision + let collx = + if d1x < 0 + then + let (V2 _ g1s) = m1p1 + ((tx *) <$> d1) + (V2 _ g1e) = m1p2 + ((tx *) <$> d1) + (V2 _ g2s) = m2p4 + ((tx *) <$> d2) + (V2 _ g2e) = m2p3 + ((tx *) <$> 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] + else + let (V2 _ g1s) = m1p4 + ((tx *) <$> d1) + (V2 _ g1e) = m1p3 + ((tx *) <$> d1) + (V2 _ g2s) = m2p1 + ((tx *) <$> d2) + (V2 _ g2e) = m2p2 + ((tx *) <$> 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 = + if d1y < 0 + then + let (V2 g1s _) = m1p1 + ((ty *) <$> d1) + (V2 g1e _) = m1p4 + ((ty *) <$> d1) + (V2 g2s _) = m2p2 + ((ty *) <$> d2) + (V2 g2e _) = m2p3 + ((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] + else + let (V2 g1s _) = m1p2 + ((ty *) <$> d1) + (V2 g1e _) = m1p3 + ((ty *) <$> d1) + (V2 g2s _) = m2p1 + ((ty *) <$> d2) + (V2 g2e _) = m2p4 + ((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] + in + case (tx < dt, ty < dt, tx < ty, collx, colly) of + (_, _, True, True, _) -> + Collision tx (V2 (floor $ signum d1x) 0) + (_, _, False, _, True) -> + Collision ty (V2 0 (floor $ signum d1y)) + (_, _, _, False, False) -> + NoCollision + --(True, _, _, False, _) -> + -- NoCollision + -- (_, True, _, _, False) -> + -- NoCollision + -- (False, _, _, _, _) -> + -- NoCollision + -- (_, False, _, _, _) -> + -- NoCollision else NoCollision