From 9da16fc6a744f313d11913c788fe2db1cbd26f53 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 16 Apr 2021 18:46:01 +0200 Subject: [PATCH] fix collision halfway --- src/Classes/Physics/Collidible.hs | 56 ++++++++++++------------- src/Scenes/Test/Update.hs | 68 ++++++++++++++++--------------- 2 files changed, 64 insertions(+), 60 deletions(-) diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index 2905e95..7bb8fb1 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Classes/Physics/Collidible.hs @@ -55,16 +55,16 @@ class (Show c, Mass c) => Collidible c where m2p2 = p2 + V2 m2b1x m2b2y m2p3 = p2 + m2b2 m2p4 = p2 + V2 m2b2x m2b1y - 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 = [g11, g12, g13, g14] - g2s = [g21, g22, g23, g24] + -- 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 = [g11, g12, g13, g14] + -- g2s = [g21, g22, g23, g24] b1 = ( V2 ((\(V2 x _) -> x) (if d1x < 0 then m1p1 + ((dt *) <$> d1) else m1p1)) @@ -107,13 +107,13 @@ class (Show c, Mass c) => Collidible c where in in2 || in1 tx = - let p1x = (\(V2 x _) -> x) (if d1x < 0 then m1p1 else m1p2) - p2x = (\(V2 x _) -> x) (if d1x < 0 then m2p2 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 if d2x - d1x == 0 then dt else (p1x - p2x) / (d2x - d1x) ty = - let p1y = (\(V2 _ y) -> y) (if d1y < 0 then m1p1 else m1p4) - p2y = (\(V2 _ y) -> y) (if d1y < 0 then m2p4 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 if d2y - d1y == 0 then dt else (p1y - p2y) / (d2y - d1y) in @@ -262,18 +262,18 @@ elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx diry)) = then 0 else -((abs m1y2 + abs m2y1) - abs dy) in - (velocityUpdater - ((positionUpdater mo1) - (p1 + ((ddt *) <$> v1) - -- if ddt == 0 - -- then - -- if abs bx < abs by - -- then - -- V2 bx 0 - -- else - -- V2 0 by - -- else - -- V2 0 0 - ) - ) + (velocityUpdater mo1 + -- ((positionUpdater mo1) + -- (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/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index 32457fa..8eee0f9 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -75,25 +75,25 @@ update level dt = liftIO $ do modifyTVar (testPlayer level) $ \(Just pituicat) -> let playedCat = perform dt pituicat - collidedCat = - let partner = - V.foldl - (\acc@(_, ires) (Cast c) -> - let res = collisionCheck dt playedCat c - in - if res /= NoCollision && - collisionTime res < collisionTime ires - then (Cast c, res) - else acc - ) - (V.head updatedCast, NoCollision) - updatedCast - in - if (collisionTime $ snd partner) == dt - then playedCat - else uncurry - (\(Cast cx) res -> collide playedCat cx res) - partner + -- collidedCat = + -- let partner = + -- V.foldl + -- (\acc@(_, ires) (Cast c) -> + -- let res = collisionCheck dt playedCat c + -- in + -- if res /= NoCollision && + -- collisionTime res < collisionTime ires + -- then (Cast c, res) + -- else acc + -- ) + -- (V.head updatedCast, NoCollision) + -- updatedCast + -- in + -- if (collisionTime $ snd partner) == dt + -- then playedCat + -- else uncurry + -- (\(Cast cx) res -> collide playedCat cx res) + -- partner walledCat = performWorldCollision playedCat layer dt in Just $ move dt walledCat @@ -106,22 +106,26 @@ performWorldCollision -> c -- ^ Updated cast member performWorldCollision c layer dt = let partner = V.foldl - (\acc tile -> + (\acc@(part, cr) tile -> let res = collisionCheck dt c tile - ret = if isNothing acc - then if res /= NoCollision && collisionTime res < dt - then Just (c, res) - else Nothing - else if res /= NoCollision && - collisionTime res < collisionTime (snd (fromJust acc)) - then Just (c, res) - else acc + ret = if cr == NoCollision && res == NoCollision + then + acc + else + if cr == NoCollision && res /= NoCollision + then (tile, res) + else + if cr /= NoCollision && res == NoCollision + then + acc + else + if collisionTime cr < collisionTime res + then acc + else (tile, res) in ret ) - Nothing + (V.head layer, collisionCheck dt c $ V.head layer) layer in - if isNothing partner - then c - else uncurry (collide c) (fromJust partner) + uncurry (collide c) partner