make proper wall slide

This commit is contained in:
nek0 2021-04-17 11:33:28 +02:00
parent 84923b2622
commit efb5046ec7
2 changed files with 25 additions and 21 deletions

View File

@ -2,7 +2,7 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Scenes.Test.Update where module Scenes.Test.Update where
import Affection import Affection as A
import Control.Concurrent.STM import Control.Concurrent.STM
@ -96,7 +96,7 @@ update level dt = liftIO $ do
-- partner -- partner
walledCat = walledCat =
performWorldCollision playedCat layer dt performWorldCollision playedCat layer dt
in Just $ move dt walledCat in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat)
performWorldCollision performWorldCollision
:: (Collidible c) :: (Collidible c)

View File

@ -81,7 +81,7 @@ instance Actor Pituicat where
(p (p
{ pcAcc = 0 { pcAcc = 0
, pcTMoveVel = , pcTMoveVel =
case pcMoveState physCat of case pcMoveState p of
Just MoveRight -> V2 catMoveVelocity 0 Just MoveRight -> V2 catMoveVelocity 0
Just MoveLeft -> V2 (-catMoveVelocity) 0 Just MoveLeft -> V2 (-catMoveVelocity) 0
_ -> V2 0 0 _ -> V2 0 0
@ -89,7 +89,7 @@ instance Actor Pituicat where
) )
finalCat = physCat finalCat = physCat
{ pcMoveVel = { pcMoveVel =
lerp (min 0.95 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat) lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
, pcGrounded = if pcGrounded physCat , pcGrounded = if pcGrounded physCat
then not (abs dy * dt > 2) then not (abs dy * dt > 2)
else False else False
@ -113,18 +113,20 @@ instance Mass Pituicat where
velocityUpdater cat = velocityUpdater cat =
(\vel@(V2 vx vy) -> (\vel@(V2 vx vy) ->
let (V2 mx my) = pcMoveVel cat let
nx = (V2 mx my) = pcMoveVel cat
if abs mx > abs vx nvel = V2
(if abs mx > abs vx
then 0 then 0
else vx - mx else (signum vx) * (abs vx - abs mx)
ny = )
if abs my > abs vy (if abs my > abs vy
then 0 then 0
else vy - my else (signum vy) * (abs vy - abs my)
)
in in
cat cat
{ pcVel = (V2 nx ny) { pcVel = nvel
} }
) )
@ -146,11 +148,17 @@ instance Collidible Pituicat where
collide cat _ NoCollision = cat collide cat _ NoCollision = cat
collide cat other collr@(Collision ddt (V2 dirx diry)) = collide cat other collr@(Collision ddt (V2 dirx diry)) =
let ncat = (elasticCollision 0.3 cat other collr) let ncat = (elasticCollision 0.3 cat other collr)
vel@(V2 vx vy) = velocity cat vel@(V2 vx vy) = velocity ncat
nvel@(V2 dx dy) = velocity ncat moveVel@(V2 mx my) = pcMoveVel cat
nvel = V2
(if abs mx > abs vx
then 0
else (signum vx) * (abs vx - abs mx)
)
((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat))
grounded = grounded =
(dy * ddt) >= 0 && (vy * ddt) >= 0 &&
(dy * ddt) < 5 && diry == -1 (vy * ddt) < 5 && diry == -1
in in
A.log A.log
Debug Debug
@ -166,11 +174,7 @@ instance Collidible Pituicat where
if dirx /= 0 if dirx /= 0
then V2 0 1 then V2 0 1
else V2 1 1 else V2 1 1
, pcTMoveVel = pcTMoveVel ncat * , pcVel = nvel *
if dirx /= 0
then V2 0 1
else V2 1 1
, pcVel = pcVel ncat *
if dirx /= 0 if dirx /= 0
then V2 0 1 then V2 0 1
else V2 1 1 else V2 1 1