make proper wall slide

src/Scenes/Test/Update.hs

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

src/Types/Player.hs

@@ -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
+      let
-          nx =
+        (V2 mx my) = pcMoveVel cat
-            if abs mx > abs vx
+        nvel = V2
+          (if abs mx > abs vx
             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
-            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
+        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 =
-          (dy * ddt) >= 0 &&
+          (vy * ddt) >= 0 &&
-          (dy * ddt) < 5 && diry == -1
+          (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 *
+              , pcVel = nvel *
-                if dirx /= 0
-                then V2 0 1
-                else V2 1 1
-              , pcVel = pcVel ncat *
                 if dirx /= 0
                 then V2 0 1
                 else V2 1 1