diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index 1875c11..cbf986b 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Classes/Physics/Collidible.hs @@ -87,91 +87,103 @@ class (Show c, Mass c) => Collidible c where b21@(V2 b2minx b2miny) = fst b2 b22@(V2 b2maxx b2maxy) = snd b2 in2 = - (b1minx > b2minx && b1minx < b2maxx && b1miny > b2miny && b1miny < b2maxy) || - (b1maxx > b2minx && b1maxx < b2maxx && b1miny > b2miny && b1miny < b2maxy) || - (b1minx > b2minx && b1minx < b2maxx && b1maxy > b2miny && b1maxy < b2maxy) || - (b1maxx > b2minx && b1maxx < b2maxx && b1maxy > b2miny && b1maxy < b2maxy) + (b1minx > b2minx && b1minx < b2maxx && + b1miny > b2miny && b1miny < b2maxy) || + (b1maxx > b2minx && b1maxx < b2maxx && + b1miny > b2miny && b1miny < b2maxy) || + (b1minx > b2minx && b1minx < b2maxx && + b1maxy > b2miny && b1maxy < b2maxy) || + (b1maxx > b2minx && b1maxx < b2maxx && + b1maxy > b2miny && b1maxy < b2maxy) in1 = - (b2minx > b1minx && b2minx < b1maxx && b2miny > b1miny && b2miny < b1maxy) || - (b2maxx > b1minx && b2maxx < b1maxx && b2miny > b1miny && b2miny < b1maxy) || - (b2minx > b1minx && b2minx < b1maxx && b2maxy > b1miny && b2maxy < b1maxy) || - (b2maxx > b1minx && b2maxx < b1maxx && b2maxy > b1miny && b2maxy < b1maxy) + (b2minx > b1minx && b2minx < b1maxx && + b2miny > b1miny && b2miny < b1maxy) || + (b2maxx > b1minx && b2maxx < b1maxx && + b2miny > b1miny && b2miny < b1maxy) || + (b2minx > b1minx && b2minx < b1maxx && + b2maxy > b1miny && b2maxy < b1maxy) || + (b2maxx > b1minx && b2maxx < b1maxx && + b2maxy > b1miny && b2maxy < b1maxy) in in2 || in1 tx = - let p1x = (\(V2 x _) -> x) (if d1x < 0 then m1p1 else m1p3) - p2x = (\(V2 x _) -> x) (if d1x < 0 then m2p3 else m2p1) + let p1x = (\(V2 x _) -> x) (if d1x < 0 then m1p1 else m1p4) + p2x = (\(V2 x _) -> x) (if d1x < 0 then m2p4 else m2p1) in - (p1x - p2x) / (d2x - d1x) + if d2x - d1x == 0 then dt else (p1x - p2x) / (d2x - d1x) ty = - let p1y = (\(V2 _ y) -> y) (if d1y < 0 then m1p1 else m1p3) - p2y = (\(V2 _ y) -> y) (if d1y < 0 then m2p3 else m2p1) + let p1y = (\(V2 _ y) -> y) (if d1y < 0 then m1p1 else m1p2) + p2y = (\(V2 _ y) -> y) (if d1y < 0 then m2p2 else m2p1) in - (p1y - p2y) / (d2y - d1y) + if d2y - d1y == 0 then dt else (p1y - p2y) / (d2y - d1y) in - if tx < ty - then - if tx < dt + if broadphaseOverlap then - if d1x < 0 + if tx < ty then - let g1s = m1p1 + ((tx *) <$> d1) - g1e = m1p2 + ((tx *) <$> d1) - g2s = m2p3 + ((tx *) <$> d2) - g2e = m2p4 + ((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 + 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 - let g1s = m1p3 + ((tx *) <$> d1) - g1e = m1p4 + ((tx *) <$> d1) - g2s = m2p1 + ((tx *) <$> d2) - 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) [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 g1s = m1p2 + ((ty *) <$> d1) - g1e = m1p3 + ((ty *) <$> d1) - g2s = m2p4 + ((ty *) <$> d2) - g2e = m2p1 + ((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 g1s = m1p4 + ((ty *) <$> d1) - g1e = m1p1 + ((ty *) <$> d1) - g2s = m2p2 + ((ty *) <$> d2) - 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 + if ty < dt + then + if d1y < 0 + then + 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 + 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 + NoCollision else NoCollision @@ -252,16 +264,16 @@ elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx diry)) = in (velocityUpdater ((positionUpdater mo1) - (p1 + - if ddt == 0 - then - if abs bx < abs by - then - V2 bx 0 - else - V2 0 by - else - V2 0 0 + (p1 + ((ddt *) <$> v1) + -- if ddt == 0 + -- then + -- if abs bx < abs by + -- then + -- V2 bx 0 + -- else + -- V2 0 by + -- else + -- V2 0 0 ) ) ) nvel diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 1868780..448ec66 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -150,7 +150,7 @@ instance Collidible Pituicat where nvel@(V2 dx dy) = velocity ncat grounded = (dy * ddt) >= 0 && - (dy * ddt) < 2 && diry == -1 + (dy * ddt) < 5 && diry == -1 in A.log Debug