1 files changed, 42 insertions, 43 deletions

diff --git a/Demos/Pong/Pong.hs b/Demos/Pong/Pong.hs
index 104a92e..dd8855b 100644
--- a/Demos/Pong/Pong.hs
+++ b/Demos/Pong/Pong.hs
@@ -24,13 +24,14 @@ import           Data.Monoid         (mconcat)
 
 -- Configuration
 
-padSize             = vec2 0.07 0.02
+padSize             = vec2 0.07 0.015
 ballSize            = 0.012 :: Float
-ballSpeed           = 0.6 :: Float
+ballSpeed           = 0.7 :: Float
 initialBallVelocity = vec2 1 1
 maxBounceAngle      = (65::Float) * (pi::Float)/(180::Float)
 playerSpeed         = 1.0 :: Float
-enemySpeed          = 3.0 :: Float
+enemySpeed          = 7.0 :: Float
+enemyMomentum       = 0.1 :: Float
 initialEnemyPos     = vec2 0.5 0.9
 initialPlayerPos    = vec2 0.5 0.1
 initialBallPos      = vec2 0.5 0.5
@@ -40,9 +41,7 @@ initialBallPos      = vec2 0.5 0.5
 data GameEvent
   = MoveLeft
   | MoveRight
-  | StopLeft
-  | StopRight
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Show)
 
 -- Game objects
 
@@ -79,17 +78,9 @@ instance Spatial GameObject Vector2 Angle Transform2 where
   transform = basis
 
 
-stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject]
-stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos
-
-update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject
-update elapsed dt evts gos go =
-  let (go', s') = runStep (gostep go) elapsed dt gos evts go
-   in go' {gostep = s'}
-
 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,
@@ -98,23 +89,30 @@ newWorld =
   ]
   where makeAt = newTransform2 unitx2 unity2
 
+
+stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject]
+stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos
+
+update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject
+update elapsed dt evts gos go =
+  let (go', s') = runStep (gostep go) elapsed dt gos evts go
+   in go' {gostep = s'}
+
 -- Ball steppers
 
 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,37 +137,38 @@ 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)
 
 -- Enemy stepper
 
-stepEnemy = movePad
+stepEnemy = movePad 0 .> clamp
 
-movePad :: Step s e GameObject GameObject
-movePad = step $ \elapsed _ _ _ pad ->
-  let enemyY = 0.9
-      p = vec2 px enemyY
-      px =
-        (sin (enemySpeed * elapsed) * (0.5::Float) + (0.5::Float))
-          * ((1::Float) - (2::Float) * x padSize)
-          + x padSize
-   in (setPosition p pad, movePad)
+movePad :: Float -> Step [GameObject] e GameObject GameObject
+movePad previousMomentum = step $ \_ dt gos _ pad ->
+  let ball        = head gos
+      offset      = (x . position $ ball) - (x . position $ pad)
+      chaseVector = enemySpeed * offset
+      momentum    = previousMomentum + enemyMomentum * chaseVector
+      vx          = chaseVector + momentum
+   in (translate (vec2 (vx * dt) 0) pad, movePad momentum)
+
+sign :: Float -> Float
+sign x = if x >= 0 then 1 else -1
 
 -- Player stepper
 
 stepPlayer = sfold moveGO .> clamp
 
-moveGO =
-  mconcat
-    [ switch StopLeft  sid MoveLeft  (moveGO' $ vec2 (-playerSpeed) 0),
-      switch StopRight sid MoveRight (moveGO' $ vec2   playerSpeed  0)
-    ]
+moveGO = mconcat
+  [ swhen MoveLeft  $ moveGO' (vec2 (-playerSpeed) 0)
+  , swhen MoveRight $ moveGO' (vec2   playerSpeed  0)
+  ]
 
 moveGO' :: Vector2 -> Step s e GameObject GameObject
 moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir)