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

View File

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