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 = collisionCheck dt m1 m2 =
let d1@(V2 d1x d1y) = velocity m1 let d1@(V2 d1x d1y) = velocity m1
d2@(V2 d2x d2y) = velocity m2 d2@(V2 d2x d2y) = velocity m2
p1 = position m1 p1@(V2 p1x p1y) = position m1
p2 = position m2 p2@(V2 p2x p2y) = position m2
(m1b1@(V2 m1b1x m1b1y), m1b2@(V2 m1b2x m1b2y)) = boundary m1 (m1b1@(V2 m1b1x m1b1y), m1b2@(V2 m1b2x m1b2y)) = boundary m1
(m2b1@(V2 m2b1x m2b1y), m2b2@(V2 m2b2x m2b2y)) = boundary m2 (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 m1p1 = p1 + m1b1
m1p2 = p1 + V2 m1b1x m1b2y m1p2 = p1 + V2 m1b1x m1b2y
m1p3 = p1 + m1b2 m1p3 = p1 + m1b2
m1p4 = p1 + V2 m1b2x m1b1y m1p4@(V2 m1p4x _) = p1 + V2 m1b2x m1b1y
m2p1 = p2 + m2b1 m2p1@(V2 m2p1x _) = p2 + m2b1
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
@ -92,23 +94,23 @@ class (Show c, Mass c) => Collidible c where
in2 || in1 in2 || in1
overlap = overlap =
let in1 = let in1 =
(m1b1x > m2b1x && m1b1x < m2b2x && (pm1b1x > pm2b1x && pm1b1x < pm2b2x &&
m1b1y > m2b1y && m1b1y < m2b2y) || pm1b1y > pm2b1y && pm1b1y < pm2b2y) ||
(m1b2x > m2b1x && m1b2x < m2b2x && (pm1b2x > pm2b1x && pm1b2x < pm2b2x &&
m1b1y > m2b1y && m1b1y < m2b2y) || pm1b1y > pm2b1y && pm1b1y < pm2b2y) ||
(m1b1x > m2b1x && m1b2x < m2b2x && (pm1b1x > pm2b1x && pm1b2x < pm2b2x &&
m1b2y > m2b1y && m1b2y < m2b2y) || pm1b2y > pm2b1y && pm1b2y < pm2b2y) ||
(m1b2x > m2b1x && m1b2x < m2b2x && (pm1b2x > pm2b1x && pm1b2x < pm2b2x &&
m1b2y > m2b1y && m1b2y < m2b2y) pm1b2y > pm2b1y && pm1b2y < pm2b2y)
in2 = in2 =
(m2b1x > m1b1x && m2b1x < m1b2x && (pm2b1x > pm1b1x && pm2b1x < pm1b2x &&
m2b1y > m1b1y && m2b1y < m1b2y) || pm2b1y > pm1b1y && pm2b1y < pm1b2y) ||
(m2b2x > m1b1x && m2b2x < m1b2x && (pm2b2x > pm1b1x && pm2b2x < pm1b2x &&
m2b1y > m1b1y && m2b1y < m1b2y) || pm2b1y > pm1b1y && pm2b1y < pm1b2y) ||
(m2b1x > m1b1x && m2b2x < m1b2x && (pm2b1x > pm1b1x && pm2b2x < pm1b2x &&
m2b2y > m1b1y && m2b2y < m1b2y) || pm2b2y > pm1b1y && pm2b2y < pm1b2y) ||
(m2b2x > m1b1x && m2b2x < m1b2x && (pm2b2x > pm1b1x && pm2b2x < pm1b2x &&
m2b2y > m1b1y && m2b2y < m1b2y) pm2b2y > pm1b1y && pm2b2y < pm1b2y)
in in
in2 || in1 in2 || in1
tx = tx =
@ -124,16 +126,6 @@ class (Show c, Mass c) => Collidible c where
in in
if broadphaseOverlap if broadphaseOverlap
then 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 coll xdir =
let (p11, p12, p21, p22) let (p11, p12, p21, p22)
| xdir = | xdir =
@ -169,10 +161,10 @@ class (Show c, Mass c) => Collidible c where
Collision tx (V2 (floor $ signum d1x) 0) Collision tx (V2 (floor $ signum d1x) 0)
(_, True, True, False, True) -> (_, True, True, False, True) ->
Collision ty (V2 0 (floor $ signum d1y)) Collision ty (V2 0 (floor $ signum d1y))
(True, _, True, False, _) -> -- (True, _, True, False, _) ->
NoCollision -- NoCollision
(_, True, False, _, False) -> -- (_, True, False, _, False) ->
NoCollision -- NoCollision
(_, _, _, False, False) -> (_, _, _, False, False) ->
NoCollision NoCollision
(_, _, True, _, _) -> (_, _, True, _, _) ->
@ -183,12 +175,13 @@ class (Show c, Mass c) => Collidible c where
"Unhandled combination of collision check results: " "Unhandled combination of collision check results: "
<> fromString (show x) <> fromString (show x)
in in
case res of
Collision _ _ ->
res res
-- case res of NoCollision ->
-- Collision _ _ -> if overlap
-- A.log A.Debug "colliding!" res then Collision 0 (V2 0 0)
-- NoCollision -> else NoCollision
-- res
else else
NoCollision NoCollision
@ -211,7 +204,7 @@ elasticCollision
-> Double -- ^ Timestep length -> Double -- ^ Timestep length
-> c1 -> c1
elasticCollision _ mo1 (_, NoCollision) _ = mo1 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 let v1@(V2 v1x v1y) = velocity mo1
(V2 v2x v2y) = velocity mo2 (V2 v2x v2y) = velocity mo2
p1 = position mo1 p1 = position mo1
@ -231,5 +224,12 @@ elasticCollision damping mo1 (mo2, (Collision ddt (V2 dirx _))) _ =
in in
velocityUpdater velocityUpdater
mo1 mo1
-- (positionUpdater mo1 (p1 + ((ddt *) <$> v1))) -- (positionUpdater
-- mo1
-- (p1 +
-- if dirx == 0 && diry == 0
-- then (dt *) <$> V2 (-v1x) 0
-- else (ddt *) <$> v1
-- )
-- )
nvel nvel

View file

@ -97,7 +97,14 @@ update level dt = liftIO $ do
(aindex, res) (aindex, res)
in in
tangibles `V.update` 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 (newCast, newPowerups, mnewCat@(Just _)) = V.foldl
(\acc@(castAcc, pAcc, _) input -> (\acc@(castAcc, pAcc, _) input ->
case input of case input of

View file

@ -114,12 +114,12 @@ instance Actor Pituicat where
} }
) )
finalCat = physCat 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) lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
, pcGrounded = pcGrounded physCat && abs dy * dt <= 2 , pcGrounded = pcGrounded physCat && abs dy * dt <= 2
, pcPos = pcPos physCat + if not (pcXColl physCat) -- , pcPos = pcPos physCat + if not (pcXColl physCat)
then ((dt *) <$> pcMoveVel physCat) -- then (dt *) <$> pcMoveVel physCat
else V2 0 0 -- else V2 0 0
, pcEffects = , pcEffects =
foldl foldl
(\acc eff -> (\acc eff ->
@ -174,6 +174,13 @@ instance Mass Pituicat where
{ pcPos = pos { 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 instance Collidible Pituicat where
boundary cat = boundary cat =
@ -223,7 +230,5 @@ instance Collidible Pituicat where
in in
ncat ncat
{ pcGrounded = grounded { pcGrounded = grounded
, pcXColl = any , pcXColl = not grounded && diry /= 0
(\(_, Collision _ (V2 cx _)) -> cx /= 0)
(filter ((NoCollision /=) . snd) collrs) || dirx /= 0
} }