add collision direction to overlaps and make unground possible in movement

This commit is contained in:
nek0 2021-01-20 04:40:57 +01:00
parent ae38902d9c
commit bf04946a1b
2 changed files with 12 additions and 4 deletions

View file

@ -80,7 +80,11 @@ class (Show c, Mass c) => Collidible c where
(0 < dm `dot` da && dm `dot` da < da `dot` da) (0 < dm `dot` da && dm `dot` da < da `dot` da)
in in
if any inside quad1 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 else
let res = foldl let res = foldl
(\acc1 gx -> (\acc1 gx ->
@ -133,7 +137,7 @@ elasticCollision
-> CollisionResult Double (V2 Int) -> CollisionResult Double (V2 Int)
-> c1 -> c1
elasticCollision _ mo1 _ NoCollision = mo1 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 let v1@(V2 v1x v1y) = velocity mo1
(V2 v2x v2y) = velocity mo2 (V2 v2x v2y) = velocity mo2
p1@(V2 p1x p1y) = position mo1 p1@(V2 p1x p1y) = position mo1
@ -194,7 +198,7 @@ elasticCollision damping mo1 mo2 (Collision ddt _) =
(p1 + (p1 +
if ddt == 0 if ddt == 0
then then
if abs by > abs bx if diry == 0
then then
V2 bx 0 V2 bx 0
else else

View file

@ -76,7 +76,8 @@ instance Prop Pituicat where
instance Actor Pituicat where instance Actor Pituicat where
perform dt p = perform dt p =
let physCat = (accelerate dt . gravitate constG) let (V2 _ dy) = velocity physCat
physCat = (accelerate dt . gravitate constG)
(p (p
{ pcAcc = 0 { pcAcc = 0
, pcTMoveVel = , pcTMoveVel =
@ -89,6 +90,9 @@ instance Actor Pituicat where
finalCat = physCat finalCat = physCat
{ pcMoveVel = { pcMoveVel =
lerp (min 0.95 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat) lerp (min 0.95 (59 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
, pcGrounded = if pcGrounded physCat
then not (abs dy * dt > 2)
else False
} }
in in
finalCat finalCat