From bf04946a1b4c2782998a4d10e46d073527f2a8e7 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 20 Jan 2021 04:40:57 +0100 Subject: [PATCH] add collision direction to overlaps and make unground possible in movement --- src/Classes/Physics/Collidible.hs | 10 +++++++--- src/Types/Player.hs | 6 +++++- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index da1bfd2..8848b45 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Classes/Physics/Collidible.hs @@ -80,7 +80,11 @@ 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 (V2 0 0) + then Collision 0 + (if abs d1x > abs d1y + then V2 (round $ signum d1x) 0 + else V2 0 (round $ signum d1y) + ) else let res = foldl (\acc1 gx -> @@ -133,7 +137,7 @@ elasticCollision -> CollisionResult Double (V2 Int) -> c1 elasticCollision _ mo1 _ NoCollision = mo1 -elasticCollision damping mo1 mo2 (Collision ddt _) = +elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx diry)) = let v1@(V2 v1x v1y) = velocity mo1 (V2 v2x v2y) = velocity mo2 p1@(V2 p1x p1y) = position mo1 @@ -194,7 +198,7 @@ elasticCollision damping mo1 mo2 (Collision ddt _) = (p1 + if ddt == 0 then - if abs by > abs bx + if diry == 0 then V2 bx 0 else diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 31a2521..1bad130 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -76,7 +76,8 @@ instance Prop Pituicat where instance Actor Pituicat where perform dt p = - let physCat = (accelerate dt . gravitate constG) + let (V2 _ dy) = velocity physCat + physCat = (accelerate dt . gravitate constG) (p { pcAcc = 0 , pcTMoveVel = @@ -89,6 +90,9 @@ instance Actor Pituicat where finalCat = physCat { pcMoveVel = lerp (min 0.95 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat) + , pcGrounded = if pcGrounded physCat + then not (abs dy * dt > 2) + else False } in finalCat