fix collision halfway

This commit is contained in:
nek0 2021-04-16 18:46:01 +02:00
parent d9a0128958
commit 9da16fc6a7
2 changed files with 64 additions and 60 deletions

View File

@ -55,16 +55,16 @@ class (Show c, Mass c) => Collidible c where
m2p2 = p2 + V2 m2b1x m2b2y m2p2 = p2 + V2 m2b1x m2b2y
m2p3 = p2 + m2b2 m2p3 = p2 + m2b2
m2p4 = p2 + V2 m2b2x m2b1y m2p4 = p2 + V2 m2b2x m2b1y
g11 = (m1p1, m1p2) -- g11 = (m1p1, m1p2)
g12 = (m1p2, m1p3) -- g12 = (m1p2, m1p3)
g13 = (m1p3, m1p4) -- g13 = (m1p3, m1p4)
g14 = (m1p4, m1p1) -- g14 = (m1p4, m1p1)
g21 = (m2p1, m2p2) -- g21 = (m2p1, m2p2)
g22 = (m2p2, m2p3) -- g22 = (m2p2, m2p3)
g23 = (m2p3, m2p4) -- g23 = (m2p3, m2p4)
g24 = (m2p4, m2p1) -- g24 = (m2p4, m2p1)
g1s = [g11, g12, g13, g14] -- g1s = [g11, g12, g13, g14]
g2s = [g21, g22, g23, g24] -- g2s = [g21, g22, g23, g24]
b1 = b1 =
( V2 ( V2
((\(V2 x _) -> x) (if d1x < 0 then m1p1 + ((dt *) <$> d1) else m1p1)) ((\(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 in
in2 || in1 in2 || in1
tx = tx =
let p1x = (\(V2 x _) -> x) (if d1x < 0 then m1p1 else m1p2) let p1x = (\(V2 x _) -> x) (if d1x < 0 then m1p1 else m1p4)
p2x = (\(V2 x _) -> x) (if d1x < 0 then m2p2 else m2p1) p2x = (\(V2 x _) -> x) (if d1x < 0 then m2p4 else m2p1)
in in
if d2x - d1x == 0 then dt else (p1x - p2x) / (d2x - d1x) if d2x - d1x == 0 then dt else (p1x - p2x) / (d2x - d1x)
ty = ty =
let p1y = (\(V2 _ y) -> y) (if d1y < 0 then m1p1 else m1p4) let p1y = (\(V2 _ y) -> y) (if d1y < 0 then m1p1 else m1p2)
p2y = (\(V2 _ y) -> y) (if d1y < 0 then m2p4 else m2p1) p2y = (\(V2 _ y) -> y) (if d1y < 0 then m2p2 else m2p1)
in in
if d2y - d1y == 0 then dt else (p1y - p2y) / (d2y - d1y) if d2y - d1y == 0 then dt else (p1y - p2y) / (d2y - d1y)
in in
@ -262,18 +262,18 @@ elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx diry)) =
then 0 then 0
else -((abs m1y2 + abs m2y1) - abs dy) else -((abs m1y2 + abs m2y1) - abs dy)
in in
(velocityUpdater (velocityUpdater mo1
((positionUpdater mo1) -- ((positionUpdater mo1)
(p1 + ((ddt *) <$> v1) -- (p1 + ((ddt *) <$> v1)
-- if ddt == 0 -- -- if ddt == 0
-- then -- -- then
-- if abs bx < abs by -- -- if abs bx < abs by
-- then -- -- then
-- V2 bx 0 -- -- V2 bx 0
-- else -- -- else
-- V2 0 by -- -- V2 0 by
-- else -- -- else
-- V2 0 0 -- -- V2 0 0
) -- )
) -- )
) nvel ) nvel

View File

@ -75,25 +75,25 @@ update level dt = liftIO $ do
modifyTVar modifyTVar
(testPlayer level) $ \(Just pituicat) -> (testPlayer level) $ \(Just pituicat) ->
let playedCat = perform dt pituicat let playedCat = perform dt pituicat
collidedCat = -- collidedCat =
let partner = -- let partner =
V.foldl -- V.foldl
(\acc@(_, ires) (Cast c) -> -- (\acc@(_, ires) (Cast c) ->
let res = collisionCheck dt playedCat c -- let res = collisionCheck dt playedCat c
in -- in
if res /= NoCollision && -- if res /= NoCollision &&
collisionTime res < collisionTime ires -- collisionTime res < collisionTime ires
then (Cast c, res) -- then (Cast c, res)
else acc -- else acc
) -- )
(V.head updatedCast, NoCollision) -- (V.head updatedCast, NoCollision)
updatedCast -- updatedCast
in -- in
if (collisionTime $ snd partner) == dt -- if (collisionTime $ snd partner) == dt
then playedCat -- then playedCat
else uncurry -- else uncurry
(\(Cast cx) res -> collide playedCat cx res) -- (\(Cast cx) res -> collide playedCat cx res)
partner -- partner
walledCat = walledCat =
performWorldCollision playedCat layer dt performWorldCollision playedCat layer dt
in Just $ move dt walledCat in Just $ move dt walledCat
@ -106,22 +106,26 @@ performWorldCollision
-> c -- ^ Updated cast member -> c -- ^ Updated cast member
performWorldCollision c layer dt = performWorldCollision c layer dt =
let partner = V.foldl let partner = V.foldl
(\acc tile -> (\acc@(part, cr) tile ->
let res = collisionCheck dt c tile let res = collisionCheck dt c tile
ret = if isNothing acc ret = if cr == NoCollision && res == NoCollision
then if res /= NoCollision && collisionTime res < dt then
then Just (c, res) acc
else Nothing else
else if res /= NoCollision && if cr == NoCollision && res /= NoCollision
collisionTime res < collisionTime (snd (fromJust acc)) then (tile, res)
then Just (c, res) else
else acc if cr /= NoCollision && res == NoCollision
then
acc
else
if collisionTime cr < collisionTime res
then acc
else (tile, res)
in in
ret ret
) )
Nothing (V.head layer, collisionCheck dt c $ V.head layer)
layer layer
in in
if isNothing partner uncurry (collide c) partner
then c
else uncurry (collide c) (fromJust partner)