reworked player movement

This commit is contained in:
nek0 2021-07-25 10:11:28 +02:00
parent 8dd37e8e95
commit 5c634c3865
3 changed files with 107 additions and 95 deletions

View file

@ -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,16 +126,6 @@ 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 =
@ -169,10 +161,10 @@ class (Show c, Mass c) => Collidible c where
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
-- (True, _, True, False, _) ->
-- NoCollision
-- (_, True, False, _, False) ->
-- NoCollision
(_, _, _, False, False) ->
NoCollision
(_, _, True, _, _) ->
@ -183,12 +175,13 @@ class (Show c, Mass c) => Collidible c where
"Unhandled combination of collision check results: "
<> fromString (show x)
in
case res of
Collision _ _ ->
res
-- case res of
-- Collision _ _ ->
-- A.log A.Debug "colliding!" res
-- NoCollision ->
-- 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

View file

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

View file

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