reworked player movement
This commit is contained in:
parent
8dd37e8e95
commit
5c634c3865
3 changed files with 107 additions and 95 deletions
|
|
@ -41,15 +41,17 @@ class (Show c, Mass c) => Collidible c where
|
|||
collisionCheck dt m1 m2 =
|
||||
let d1@(V2 d1x d1y) = velocity m1
|
||||
d2@(V2 d2x d2y) = velocity m2
|
||||
p1 = position m1
|
||||
p2 = position m2
|
||||
p1@(V2 p1x p1y) = position m1
|
||||
p2@(V2 p2x p2y) = position m2
|
||||
(m1b1@(V2 m1b1x m1b1y), m1b2@(V2 m1b2x m1b2y)) = boundary m1
|
||||
(m2b1@(V2 m2b1x m2b1y), m2b2@(V2 m2b2x m2b2y)) = boundary m2
|
||||
(V2 pm1b1x pm1b1y, V2 pm1b2x pm1b2y) = (p1 +) <$> boundary m1
|
||||
(V2 pm2b1x pm2b1y, V2 pm2b2x pm2b2y) = (p2 +) <$> boundary m2
|
||||
m1p1 = p1 + m1b1
|
||||
m1p2 = p1 + V2 m1b1x m1b2y
|
||||
m1p3 = p1 + m1b2
|
||||
m1p4 = p1 + V2 m1b2x m1b1y
|
||||
m2p1 = p2 + m2b1
|
||||
m1p4@(V2 m1p4x _) = p1 + V2 m1b2x m1b1y
|
||||
m2p1@(V2 m2p1x _) = p2 + m2b1
|
||||
m2p2 = p2 + V2 m2b1x m2b2y
|
||||
m2p3 = p2 + m2b2
|
||||
m2p4 = p2 + V2 m2b2x m2b1y
|
||||
|
|
@ -92,23 +94,23 @@ class (Show c, Mass c) => Collidible c where
|
|||
in2 || in1
|
||||
overlap =
|
||||
let in1 =
|
||||
(m1b1x > m2b1x && m1b1x < m2b2x &&
|
||||
m1b1y > m2b1y && m1b1y < m2b2y) ||
|
||||
(m1b2x > m2b1x && m1b2x < m2b2x &&
|
||||
m1b1y > m2b1y && m1b1y < m2b2y) ||
|
||||
(m1b1x > m2b1x && m1b2x < m2b2x &&
|
||||
m1b2y > m2b1y && m1b2y < m2b2y) ||
|
||||
(m1b2x > m2b1x && m1b2x < m2b2x &&
|
||||
m1b2y > m2b1y && m1b2y < m2b2y)
|
||||
(pm1b1x > pm2b1x && pm1b1x < pm2b2x &&
|
||||
pm1b1y > pm2b1y && pm1b1y < pm2b2y) ||
|
||||
(pm1b2x > pm2b1x && pm1b2x < pm2b2x &&
|
||||
pm1b1y > pm2b1y && pm1b1y < pm2b2y) ||
|
||||
(pm1b1x > pm2b1x && pm1b2x < pm2b2x &&
|
||||
pm1b2y > pm2b1y && pm1b2y < pm2b2y) ||
|
||||
(pm1b2x > pm2b1x && pm1b2x < pm2b2x &&
|
||||
pm1b2y > pm2b1y && pm1b2y < pm2b2y)
|
||||
in2 =
|
||||
(m2b1x > m1b1x && m2b1x < m1b2x &&
|
||||
m2b1y > m1b1y && m2b1y < m1b2y) ||
|
||||
(m2b2x > m1b1x && m2b2x < m1b2x &&
|
||||
m2b1y > m1b1y && m2b1y < m1b2y) ||
|
||||
(m2b1x > m1b1x && m2b2x < m1b2x &&
|
||||
m2b2y > m1b1y && m2b2y < m1b2y) ||
|
||||
(m2b2x > m1b1x && m2b2x < m1b2x &&
|
||||
m2b2y > m1b1y && m2b2y < m1b2y)
|
||||
(pm2b1x > pm1b1x && pm2b1x < pm1b2x &&
|
||||
pm2b1y > pm1b1y && pm2b1y < pm1b2y) ||
|
||||
(pm2b2x > pm1b1x && pm2b2x < pm1b2x &&
|
||||
pm2b1y > pm1b1y && pm2b1y < pm1b2y) ||
|
||||
(pm2b1x > pm1b1x && pm2b2x < pm1b2x &&
|
||||
pm2b2y > pm1b1y && pm2b2y < pm1b2y) ||
|
||||
(pm2b2x > pm1b1x && pm2b2x < pm1b2x &&
|
||||
pm2b2y > pm1b1y && pm2b2y < pm1b2y)
|
||||
in
|
||||
in2 || in1
|
||||
tx =
|
||||
|
|
@ -124,71 +126,62 @@ class (Show c, Mass c) => Collidible c where
|
|||
in
|
||||
if broadphaseOverlap
|
||||
then
|
||||
-- if overlap
|
||||
if False
|
||||
then
|
||||
Collision
|
||||
(if tx < ty then tx else ty)
|
||||
(if tx < ty
|
||||
then V2 (floor $ signum d1x) 0
|
||||
else V2 0 (floor $ signum d1y)
|
||||
)
|
||||
else
|
||||
let coll xdir =
|
||||
let (p11, p12, p21, p22)
|
||||
| xdir =
|
||||
if d1x < 0
|
||||
then
|
||||
(m1p1, m1p2, m2p4, m2p3)
|
||||
else
|
||||
(m1p4, m1p3, m2p1, m2p2)
|
||||
| otherwise =
|
||||
if d1y < 0
|
||||
then
|
||||
(m1p1, m1p4, m2p2, m2p3)
|
||||
else
|
||||
(m1p2, m1p3, m2p1, m2p4)
|
||||
vselector (V2 x y) = if xdir then y else x
|
||||
tick = if xdir then tx else ty
|
||||
g1s = vselector $ p11 + ((tick *) <$> d1)
|
||||
g1e = vselector $ p12 + ((tick *) <$> d1)
|
||||
g2s = vselector $ p21 + ((tick *) <$> d2)
|
||||
g2e = vselector $ p22 + ((tick *) <$> d2)
|
||||
s11 = (g1s - g2s) / (g2e - g2s)
|
||||
s12 = (g1e - g2s) / (g2e - g2s)
|
||||
s21 = (g2s - g1s) / (g1e - g1s)
|
||||
s22 = (g2e - g1s) / (g1e - g1s)
|
||||
in
|
||||
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
|
||||
res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of
|
||||
(True, _, True, True, _) ->
|
||||
Collision tx (V2 (floor $ signum d1x) 0)
|
||||
(_, True, False, _, True) ->
|
||||
Collision ty (V2 0 (floor $ signum d1y))
|
||||
(True, _, False, True, False) ->
|
||||
Collision tx (V2 (floor $ signum d1x) 0)
|
||||
(_, True, True, False, True) ->
|
||||
Collision ty (V2 0 (floor $ signum d1y))
|
||||
(True, _, True, False, _) ->
|
||||
NoCollision
|
||||
(_, True, False, _, False) ->
|
||||
NoCollision
|
||||
(_, _, _, False, False) ->
|
||||
NoCollision
|
||||
(_, _, True, _, _) ->
|
||||
A.log A.Debug "CORNER CASE!" NoCollision
|
||||
(False, False, _, _, _) ->
|
||||
NoCollision
|
||||
x -> error $
|
||||
"Unhandled combination of collision check results: "
|
||||
<> fromString (show x)
|
||||
in
|
||||
res
|
||||
-- case res of
|
||||
-- Collision _ _ ->
|
||||
-- A.log A.Debug "colliding!" res
|
||||
-- NoCollision ->
|
||||
-- res
|
||||
let coll xdir =
|
||||
let (p11, p12, p21, p22)
|
||||
| xdir =
|
||||
if d1x < 0
|
||||
then
|
||||
(m1p1, m1p2, m2p4, m2p3)
|
||||
else
|
||||
(m1p4, m1p3, m2p1, m2p2)
|
||||
| otherwise =
|
||||
if d1y < 0
|
||||
then
|
||||
(m1p1, m1p4, m2p2, m2p3)
|
||||
else
|
||||
(m1p2, m1p3, m2p1, m2p4)
|
||||
vselector (V2 x y) = if xdir then y else x
|
||||
tick = if xdir then tx else ty
|
||||
g1s = vselector $ p11 + ((tick *) <$> d1)
|
||||
g1e = vselector $ p12 + ((tick *) <$> d1)
|
||||
g2s = vselector $ p21 + ((tick *) <$> d2)
|
||||
g2e = vselector $ p22 + ((tick *) <$> d2)
|
||||
s11 = (g1s - g2s) / (g2e - g2s)
|
||||
s12 = (g1e - g2s) / (g2e - g2s)
|
||||
s21 = (g2s - g1s) / (g1e - g1s)
|
||||
s22 = (g2e - g1s) / (g1e - g1s)
|
||||
in
|
||||
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
|
||||
res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of
|
||||
(True, _, True, True, _) ->
|
||||
Collision tx (V2 (floor $ signum d1x) 0)
|
||||
(_, True, False, _, True) ->
|
||||
Collision ty (V2 0 (floor $ signum d1y))
|
||||
(True, _, False, True, False) ->
|
||||
Collision tx (V2 (floor $ signum d1x) 0)
|
||||
(_, True, True, False, True) ->
|
||||
Collision ty (V2 0 (floor $ signum d1y))
|
||||
-- (True, _, True, False, _) ->
|
||||
-- NoCollision
|
||||
-- (_, True, False, _, False) ->
|
||||
-- NoCollision
|
||||
(_, _, _, False, False) ->
|
||||
NoCollision
|
||||
(_, _, True, _, _) ->
|
||||
A.log A.Debug "CORNER CASE!" NoCollision
|
||||
(False, False, _, _, _) ->
|
||||
NoCollision
|
||||
x -> error $
|
||||
"Unhandled combination of collision check results: "
|
||||
<> fromString (show x)
|
||||
in
|
||||
case res of
|
||||
Collision _ _ ->
|
||||
res
|
||||
NoCollision ->
|
||||
if overlap
|
||||
then Collision 0 (V2 0 0)
|
||||
else NoCollision
|
||||
else
|
||||
NoCollision
|
||||
|
||||
|
|
@ -211,7 +204,7 @@ elasticCollision
|
|||
-> Double -- ^ Timestep length
|
||||
-> c1
|
||||
elasticCollision _ mo1 (_, NoCollision) _ = mo1
|
||||
elasticCollision damping mo1 (mo2, (Collision ddt (V2 dirx _))) _ =
|
||||
elasticCollision damping mo1 (mo2, Collision ddt (V2 dirx diry)) dt =
|
||||
let v1@(V2 v1x v1y) = velocity mo1
|
||||
(V2 v2x v2y) = velocity mo2
|
||||
p1 = position mo1
|
||||
|
|
@ -231,5 +224,12 @@ elasticCollision damping mo1 (mo2, (Collision ddt (V2 dirx _))) _ =
|
|||
in
|
||||
velocityUpdater
|
||||
mo1
|
||||
-- (positionUpdater mo1 (p1 + ((ddt *) <$> v1)))
|
||||
-- (positionUpdater
|
||||
-- mo1
|
||||
-- (p1 +
|
||||
-- if dirx == 0 && diry == 0
|
||||
-- then (dt *) <$> V2 (-v1x) 0
|
||||
-- else (ddt *) <$> v1
|
||||
-- )
|
||||
-- )
|
||||
nvel
|
||||
|
|
|
|||
|
|
@ -97,7 +97,14 @@ update level dt = liftIO $ do
|
|||
(aindex, res)
|
||||
in
|
||||
tangibles `V.update`
|
||||
V.map updater collisionPartners
|
||||
V.map
|
||||
updater
|
||||
(A.log
|
||||
A.Debug
|
||||
("Collision partners: " <>
|
||||
fromString (show collisionPartners))
|
||||
collisionPartners
|
||||
)
|
||||
(newCast, newPowerups, mnewCat@(Just _)) = V.foldl
|
||||
(\acc@(castAcc, pAcc, _) input ->
|
||||
case input of
|
||||
|
|
|
|||
|
|
@ -114,12 +114,12 @@ instance Actor Pituicat where
|
|||
}
|
||||
)
|
||||
finalCat = physCat
|
||||
{ pcMoveVel =
|
||||
{ pcMoveVel = (if pcXColl physCat then V2 0 1 else V2 1 1) *
|
||||
lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
|
||||
, pcGrounded = pcGrounded physCat && abs dy * dt <= 2
|
||||
, pcPos = pcPos physCat + if not (pcXColl physCat)
|
||||
then ((dt *) <$> pcMoveVel physCat)
|
||||
else V2 0 0
|
||||
-- , pcPos = pcPos physCat + if not (pcXColl physCat)
|
||||
-- then (dt *) <$> pcMoveVel physCat
|
||||
-- else V2 0 0
|
||||
, pcEffects =
|
||||
foldl
|
||||
(\acc eff ->
|
||||
|
|
@ -174,6 +174,13 @@ instance Mass Pituicat where
|
|||
{ pcPos = pos
|
||||
}
|
||||
|
||||
move dt cat =
|
||||
let dpos = (dt *) <$> velocity cat
|
||||
mpos = (dt *) <$>
|
||||
(if pcXColl cat then V2 (-1) 1 else V2 1 1) * pcMoveVel cat
|
||||
in
|
||||
positionUpdater cat (position cat + dpos + mpos)
|
||||
|
||||
instance Collidible Pituicat where
|
||||
|
||||
boundary cat =
|
||||
|
|
@ -223,7 +230,5 @@ instance Collidible Pituicat where
|
|||
in
|
||||
ncat
|
||||
{ pcGrounded = grounded
|
||||
, pcXColl = any
|
||||
(\(_, Collision _ (V2 cx _)) -> cx /= 0)
|
||||
(filter ((NoCollision /=) . snd) collrs) || dirx /= 0
|
||||
, pcXColl = not grounded && diry /= 0
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue