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