From 69a71a5cd2bd2cffc55402305c14a39db3eed23e Mon Sep 17 00:00:00 2001
From: 3gg <3gg@shellblade.net>
Date: Wed, 14 Aug 2024 19:12:03 -0700
Subject: Smoother collisions.
---
Demos/Pong/Pong.hs | 26 ++++++++++++--------------
1 file changed, 12 insertions(+), 14 deletions(-)
(limited to 'Demos/Pong')
diff --git a/Demos/Pong/Pong.hs b/Demos/Pong/Pong.hs
index 104a92e..943682f 100644
--- a/Demos/Pong/Pong.hs
+++ b/Demos/Pong/Pong.hs
@@ -89,7 +89,7 @@ update elapsed dt evts gos go =
ballBox, padBox :: AABB2
ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize
-padBox = AABB2 (-padSize) padSize
+padBox = AABB2 (-padSize) padSize
newWorld =
[ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity,
@@ -102,19 +102,17 @@ newWorld =
stepBall vel = collideBall vel .> moveBall
--- TODO: in collideBall and paddleBounce, we should an apply an offset to the
--- ball when collision is detected.
collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
collideBall vel = step $ \_ dt gos _ ball ->
let (AABB2 pmin pmax) = translate (position ball) (aabb ball)
- collideSide = x pmin < 0 || x pmax > 1
- collideBack = y pmin < 0 || y pmax > 1
- collidePaddle = any (collide ball) (tail gos)
- flipX v@(Vector2 x y) = if collideSide then vec2 (-x) y else v
- flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v
+ sideCollision = x pmin < 0 || x pmax > 1
+ backCollision = y pmin < 0 || y pmax > 1
+ flipX v@(Vector2 x y) = if sideCollision then vec2 (-x) y else v
+ flipY v@(Vector2 x y) = if backCollision then vec2 x (-y) else v
vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel
- -- A small delta to apply when collision occurs.
- delta = (1::Float) + if collideSide || collideBack || collidePaddle then (2::Float)*dt else (0::Float)
+ collision = vel' /= vel
+ -- Apply offset when collision occurs to avoid sticky collisions.
+ delta = (1::Float) + if collision then (3::Float)*dt else (0::Float)
in ((ballSpeed * delta * vel', ball), collideBall vel')
paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2
@@ -139,10 +137,10 @@ collide go1 go2 =
(AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) =
translate (position go2) (aabb go2)
in not $
- xmax1 < xmin2
- || xmin1 > xmax2
- || ymax1 < ymin2
- || ymin1 > ymax2
+ xmax1 < xmin2 ||
+ xmin1 > xmax2 ||
+ ymax1 < ymin2 ||
+ ymin1 > ymax2
moveBall :: Step s e (Vector2, GameObject) GameObject
moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall)
--
cgit v1.2.3