aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Demos/Pong/Pong.hs26
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
90ballBox, padBox :: AABB2 90ballBox, padBox :: AABB2
91ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize 91ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize
92padBox = AABB2 (-padSize) padSize 92padBox = AABB2 (-padSize) padSize
93 93
94newWorld = 94newWorld =
95 [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity, 95 [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity,
@@ -102,19 +102,17 @@ newWorld =
102 102
103stepBall vel = collideBall vel .> moveBall 103stepBall 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.
107collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) 105collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
108collideBall vel = step $ \_ dt gos _ ball -> 106collideBall 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
120paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 118paddleBounce :: 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
147moveBall :: Step s e (Vector2, GameObject) GameObject 145moveBall :: Step s e (Vector2, GameObject) GameObject
148moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) 146moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall)