diff options
author | 3gg <3gg@shellblade.net> | 2024-08-14 19:12:03 -0700 |
---|---|---|
committer | 3gg <3gg@shellblade.net> | 2024-08-14 19:12:03 -0700 |
commit | 69a71a5cd2bd2cffc55402305c14a39db3eed23e (patch) | |
tree | 306228c3601f37b2f919c3ee2cbadf1ff0ebe74b | |
parent | 3abf8ad3308407f70a32c8cc840973172c3d84d7 (diff) |
Smoother collisions.
-rw-r--r-- | Demos/Pong/Pong.hs | 26 |
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 = | |||
89 | 89 | ||
90 | ballBox, padBox :: AABB2 | 90 | ballBox, padBox :: AABB2 |
91 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize | 91 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize |
92 | padBox = AABB2 (-padSize) padSize | 92 | padBox = AABB2 (-padSize) padSize |
93 | 93 | ||
94 | newWorld = | 94 | newWorld = |
95 | [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity, | 95 | [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity, |
@@ -102,19 +102,17 @@ newWorld = | |||
102 | 102 | ||
103 | stepBall vel = collideBall vel .> moveBall | 103 | stepBall vel = collideBall vel .> moveBall |
104 | 104 | ||
105 | -- TODO: in collideBall and paddleBounce, we should an apply an offset to the | ||
106 | -- ball when collision is detected. | ||
107 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) | 105 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) |
108 | collideBall vel = step $ \_ dt gos _ ball -> | 106 | collideBall vel = step $ \_ dt gos _ ball -> |
109 | let (AABB2 pmin pmax) = translate (position ball) (aabb ball) | 107 | let (AABB2 pmin pmax) = translate (position ball) (aabb ball) |
110 | collideSide = x pmin < 0 || x pmax > 1 | 108 | sideCollision = x pmin < 0 || x pmax > 1 |
111 | collideBack = y pmin < 0 || y pmax > 1 | 109 | backCollision = y pmin < 0 || y pmax > 1 |
112 | collidePaddle = any (collide ball) (tail gos) | 110 | flipX v@(Vector2 x y) = if sideCollision then vec2 (-x) y else v |
113 | flipX v@(Vector2 x y) = if collideSide then vec2 (-x) y else v | 111 | flipY v@(Vector2 x y) = if backCollision then vec2 x (-y) else v |
114 | flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v | ||
115 | vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel | 112 | vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel |
116 | -- A small delta to apply when collision occurs. | 113 | collision = vel' /= vel |
117 | delta = (1::Float) + if collideSide || collideBack || collidePaddle then (2::Float)*dt else (0::Float) | 114 | -- Apply offset when collision occurs to avoid sticky collisions. |
115 | delta = (1::Float) + if collision then (3::Float)*dt else (0::Float) | ||
118 | in ((ballSpeed * delta * vel', ball), collideBall vel') | 116 | in ((ballSpeed * delta * vel', ball), collideBall vel') |
119 | 117 | ||
120 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 | 118 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 |
@@ -139,10 +137,10 @@ collide go1 go2 = | |||
139 | (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = | 137 | (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = |
140 | translate (position go2) (aabb go2) | 138 | translate (position go2) (aabb go2) |
141 | in not $ | 139 | in not $ |
142 | xmax1 < xmin2 | 140 | xmax1 < xmin2 || |
143 | || xmin1 > xmax2 | 141 | xmin1 > xmax2 || |
144 | || ymax1 < ymin2 | 142 | ymax1 < ymin2 || |
145 | || ymin1 > ymax2 | 143 | ymin1 > ymax2 |
146 | 144 | ||
147 | moveBall :: Step s e (Vector2, GameObject) GameObject | 145 | moveBall :: Step s e (Vector2, GameObject) GameObject |
148 | moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) | 146 | moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) |