nek0/pituicat
2
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

reworked player movement

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

174
src/Physics/Classes/Collidible.hs
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,71 +126,62 @@ class (Show c, Mass c) => Collidible c where
in in
if broadphaseOverlap if broadphaseOverlap
then then
-- if overlap let coll xdir =
if False let (p11, p12, p21, p22)
then | xdir =
Collision if d1x < 0
(if tx < ty then tx else ty) then
(if tx < ty (m1p1, m1p2, m2p4, m2p3)
then V2 (floor $ signum d1x) 0 else
else V2 0 (floor $ signum d1y) (m1p4, m1p3, m2p1, m2p2)
) | otherwise =
else if d1y < 0
let coll xdir = then
let (p11, p12, p21, p22) (m1p1, m1p4, m2p2, m2p3)
| xdir = else
if d1x < 0 (m1p2, m1p3, m2p1, m2p4)
then vselector (V2 x y) = if xdir then y else x
(m1p1, m1p2, m2p4, m2p3) tick = if xdir then tx else ty
else g1s = vselector $ p11 + ((tick *) <$> d1)
(m1p4, m1p3, m2p1, m2p2) g1e = vselector $ p12 + ((tick *) <$> d1)
| otherwise = g2s = vselector $ p21 + ((tick *) <$> d2)
if d1y < 0 g2e = vselector $ p22 + ((tick *) <$> d2)
then s11 = (g1s - g2s) / (g2e - g2s)
(m1p1, m1p4, m2p2, m2p3) s12 = (g1e - g2s) / (g2e - g2s)
else s21 = (g2s - g1s) / (g1e - g1s)
(m1p2, m1p3, m2p1, m2p4) s22 = (g2e - g1s) / (g1e - g1s)
vselector (V2 x y) = if xdir then y else x in
tick = if xdir then tx else ty any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22]
g1s = vselector $ p11 + ((tick *) <$> d1) res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of
g1e = vselector $ p12 + ((tick *) <$> d1) (True, _, True, True, _) ->
g2s = vselector $ p21 + ((tick *) <$> d2) Collision tx (V2 (floor $ signum d1x) 0)
g2e = vselector $ p22 + ((tick *) <$> d2) (_, True, False, _, True) ->
s11 = (g1s - g2s) / (g2e - g2s) Collision ty (V2 0 (floor $ signum d1y))
s12 = (g1e - g2s) / (g2e - g2s) (True, _, False, True, False) ->
s21 = (g2s - g1s) / (g1e - g1s) Collision tx (V2 (floor $ signum d1x) 0)
s22 = (g2e - g1s) / (g1e - g1s) (_, True, True, False, True) ->
in Collision ty (V2 0 (floor $ signum d1y))
any (\x -> x > 0 && x < 1) [s11, s12, s21 ,s22] -- (True, _, True, False, _) ->
res = case (tx < dt, ty < dt, tx < ty, coll True, coll False) of -- NoCollision
(True, _, True, True, _) -> -- (_, True, False, _, False) ->
Collision tx (V2 (floor $ signum d1x) 0) -- NoCollision
(_, True, False, _, True) -> (_, _, _, False, False) ->
Collision ty (V2 0 (floor $ signum d1y)) NoCollision
(True, _, False, True, False) -> (_, _, True, _, _) ->
Collision tx (V2 (floor $ signum d1x) 0) A.log A.Debug "CORNER CASE!" NoCollision
(_, True, True, False, True) -> (False, False, _, _, _) ->
Collision ty (V2 0 (floor $ signum d1y)) NoCollision
(True, _, True, False, _) -> x -> error $
NoCollision "Unhandled combination of collision check results: "
(_, True, False, _, False) -> <> fromString (show x)
NoCollision in
(_, _, _, False, False) -> case res of
NoCollision Collision _ _ ->
(_, _, True, _, _) -> res
A.log A.Debug "CORNER CASE!" NoCollision NoCollision ->
(False, False, _, _, _) -> if overlap
NoCollision then Collision 0 (V2 0 0)
x -> error $ else NoCollision
"Unhandled combination of collision check results: "
<> fromString (show x)
in
res
-- case res of
-- Collision _ _ ->
-- A.log A.Debug "colliding!" res
-- 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

9
src/Scenes/Test/Update.hs
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

19
src/Types/Player.hs
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
} }