diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index faf8225..8a970e8 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/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 diff --git a/src/Types/Player.hs b/src/Types/Player.hs index a4da283..cbf32f0 100644 --- a/src/Types/Player.hs +++ b/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