Smoother collisions.

1 files changed, 12 insertions, 14 deletions

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)