fix collision halfway
This commit is contained in:
parent
d9a0128958
commit
9da16fc6a7
2 changed files with 64 additions and 60 deletions
|
|
@ -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…
Reference in a new issue