fix collision halfway

movable_objects2
nek0 2 years ago
parent d9a0128958
commit 9da16fc6a7
  1. 56
      src/Classes/Physics/Collidible.hs
  2. 68
      src/Scenes/Test/Update.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

@ -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

Loading…
Cancel
Save