more granular reaction

src/Classes/Physics/Collidible.hs

@@ -7,9 +7,9 @@ import Linear
 
 import Classes.Physics.Mass
 
-data CollisionResult a
+data CollisionResult time direction
   = NoCollision
-  | Collision a
+  | Collision time direction
   deriving (Show, Eq)
 
 -- | Typeclass for implementing collision results on objects.
@@ -26,10 +26,10 @@ class (Show c, Mass c) => Collidible c where
 
   collisionCheck
     :: (Collidible other)
-    => Double -- ^ Time step length
-    -> c      -- ^ First object
-    -> other  -- ^ second object
-    -> CollisionResult Double   -- ^ Do the objects collide?
+    => Double                          -- ^ Time step length
+    -> c                               -- ^ First object
+    -> other                           -- ^ second object
+    -> CollisionResult Double (V2 Int) -- ^ Do the objects collide?
   collisionCheck dt m1 m2 =
     let d1@(V2 d1x d1y) = (dt *) <$> velocity m1
         d2@(V2 d2x d2y) = (dt *) <$> velocity m2
@@ -69,7 +69,7 @@ class (Show c, Mass c) => Collidible c where
             (0 < dm `dot` da && dm `dot` da < da `dot` da)
     in
       if any inside quad1
-      then Collision 0
+      then Collision 0 (V2 0 0)
       else
         let res = foldl
               (\acc1 gx ->
@@ -81,28 +81,33 @@ class (Show c, Mass c) => Collidible c where
                           if (qs > 0 && qs < 1) && (qt > 0 && qt < acc2)
                           then qt
                           else acc2
-                        )
-                      acc1
+                         )
+                      (fst acc1)
                       quad1
                 in
-                  if gt < acc1
-                  then gt
+                  if gt < fst acc1
+                  then
+                    ( gt
+                    , if gx == g1 || gx == g3
+                      then V2 0 (round $ signum d1y)
+                      else V2 (round $ signum d1x) 0
+                    )
                   else acc1
                 )
-              dt
+              (dt, V2 0 0)
               gs
         in
-          if res < dt
-          then Collision res
+          if fst res < dt
+          then Collision `uncurry` res
           else NoCollision
 
   -- | This Function is called for every collision on both colliding objects.
   collide
     :: (Collidible other)
-    => c                      -- ^ Original object
-    -> other                  -- ^ Collision partner
-    -> CollisionResult Double -- ^ Collision reaction
-    -> c                      -- ^ Updated original object
+    => c                               -- ^ Original object
+    -> other                            -- ^ Collision partner
+    -> CollisionResult Double (V2 Int) -- ^ Collision reaction
+    -> c                               -- ^ Updated original object
   collide = elasticCollision 1
 
 -- | Implementation of a dampened elastic collision used as default collision
@@ -112,10 +117,10 @@ elasticCollision
   => Double
   -> c1
   -> c2
-  -> CollisionResult Double
+  -> CollisionResult Double (V2 Int)
   -> c1
 elasticCollision _ mo1 _ NoCollision = mo1
-elasticCollision damping mo1 mo2 (Collision ddt) =
+elasticCollision damping mo1 mo2 (Collision ddt direction) =
   let v1@(V2 v1x v1y) = velocity mo1
       (V2 v2x v2y) = velocity mo2
       p1@(V2 p1x p1y) = position mo1
@@ -154,7 +159,7 @@ elasticCollision damping mo1 mo2 (Collision ddt) =
           then 0
           else -((abs m1x2 + abs m2x1) - abs dx + 1)
       by = if dy <= 0
-        then
+        then 
           if abs dy >= abs m1y1 + abs m2y2 &&
             (if dx > 0
               then abs dx >= abs m1x2 + abs m2x1

src/Types/Player.hs

@@ -88,8 +88,8 @@ instance Actor Pituicat where
             )
         finalCat = physCat
           { pcMoveVel =
-            -- lerp (min 0.9 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
-            pcTMoveVel physCat
+            lerp (min 0.95 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
+            -- pcTMoveVel physCat
           }
     in
       (A.log Debug (
@@ -145,14 +145,19 @@ instance Collidible Pituicat where
     )
 
   collide cat _ NoCollision = cat
-  collide cat other collr@(Collision ddt) =
+  collide cat other collr@(Collision ddt (V2 dirx diry)) =
     A.log
       Debug
       ("*boing* meow! other: " <>
         fromString (show other))
       (
         let ncat = (elasticCollision 0.3 cat other collr)
-            (V2 dx dy) = (ddt *) <$> velocity ncat
+            (V2 dx dy) = (ddt *) <$> (
+              velocity ncat *
+              if dirx /= 0
+              then V2 0 1
+              else V2 1 1
+              )
         in
           ncat
             { pcGrounded = abs dy < 2