{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE TypeSynonymInstances  #-}

module Pong
( GameEvent (..)
, GameObject
, newWorld
, stepWorld
)
where

import           Spear.Math.AABB
import           Spear.Math.Algebra
import           Spear.Math.Spatial
import           Spear.Math.Spatial2
import           Spear.Math.Vector
import           Spear.Physics.Collision
import           Spear.Prelude
import           Spear.Step

import           Data.Monoid             (mconcat)


-- Configuration

padSize             = vec2 0.070 0.015
ballSize            = vec2 0.012 0.012
ballSpeed           = 0.7 :: Float
initialBallVelocity = vec2 1 1
maxBounceAngle      = (65::Float) * (pi::Float)/(180::Float)
playerSpeed         = 1.0 :: Float
enemySpeed          = 7.0 :: Float
enemyMomentum       = 1.0 :: Float
initialEnemyPos     = vec2 0.5 0.9
initialPlayerPos    = vec2 0.5 0.1
initialBallPos      = vec2 0.5 0.5

-- Game events

data GameEvent
  = MoveLeft
  | MoveRight
  | Collision GameObjectId GameObjectId
  deriving (Eq, Show)

-- Game objects

data GameObjectId
  = Ball
  | Enemy
  | Player
  deriving (Eq, Show)

data GameObject = GameObject
  { gameObjectId   :: !GameObjectId
  , gameObjectSize :: {-# UNPACK #-} !Vector2
  , basis          :: {-# UNPACK #-} !Transform2
  , gostep         :: Step [GameObject] [GameEvent] GameObject GameObject
  }


instance Has2dTransform GameObject where
  set2dTransform transform object = object { basis = transform }
  transform2 = basis


instance Positional GameObject Vector2 where
  setPosition p = with2dTransform (setPosition p)
  position = position . basis
  translate v = with2dTransform (translate v)


instance Rotational GameObject Vector2 Angle where
  setRotation r = with2dTransform (setRotation r)
  rotation = rotation . basis
  rotate angle = with2dTransform (rotate angle)
  right = right . basis
  up = up . basis
  forward = forward . basis
  setForward v = with2dTransform (setForward v)


instance Spatial GameObject Vector2 Angle Transform2 where
  setTransform t obj = obj { basis = t }
  transform = basis


instance Bounded2 GameObject where
  boundingVolume obj = aabb2Volume $ translate (position obj) (AABB2 (-size) size)
    where size = gameObjectSize obj


newWorld =
  [ GameObject Ball   ballSize (makeAt initialBallPos) $ stepBall initialBallVelocity,
    GameObject Enemy  padSize  (makeAt initialEnemyPos)  stepEnemy,
    GameObject Player padSize  (makeAt initialPlayerPos) stepPlayer
  ]
  where makeAt = newTransform2 unitx2 unity2


-- Step the game world:
--   1. Simulate physics.
--   2. Collide objects and clip -> produce collision events.
--   3. Update game objects      <- input collision events.
stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject]
stepWorld elapsed dt events gos@[ball, enemy, player] =
  let
    collisions = collide [ball] [enemy, player]
    collisionEvents = (\(x,y) -> Collision (gameObjectId x) (gameObjectId y)) <$> collisions
    events' = events ++ collisionEvents
  in
    map (update elapsed dt events' gos) gos

update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject
update elapsed dt events gos go =
  let (go', s') = runStep (gostep go) elapsed dt gos events go
   in go' { gostep = s' }


-- Ball steppers

stepBall vel = bounceBall vel .> moveBall -- .> clamp

bounceBall :: Vector2 -> Step [GameObject] [GameEvent] GameObject (Vector2, GameObject)
bounceBall vel = step $ \_ dt gos events ball ->
  let (AABB2Volume (AABB2 pmin pmax)) = boundingVolume ball
      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
      collideWithPaddles vel = foldl (paddleBounce ball events) vel (tail gos)
      vel' = normalise
           . collideWithPaddles
           . flipX
           . flipY
           $ vel
      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), bounceBall vel')

paddleBounce :: GameObject -> [GameEvent] -> Vector2 -> GameObject -> Vector2
paddleBounce ball events vel paddle =
  let collision = Collision Ball (gameObjectId paddle) `elem` events
  in if collision
  then
    let (AABB2Volume (AABB2 pmin pmax)) = boundingVolume paddle
        center = (x pmin + x pmax) / (2::Float)
        -- Normalized offset of the ball from the paddle's center, [-1, +1].
        -- It's outside the [-1, +1] range if there is no collision.
        offset = (x (position ball) - center) / ((x pmax - x pmin) / (2::Float))
        angle  = offset * maxBounceAngle
        -- When it bounces off of a paddle, y vel is flipped.
        ysign = -(signum (y vel))
    in vec2 (sin angle) (ysign * cos angle)
  else vel

moveBall :: Step s e (Vector2, GameObject) GameObject
moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall)


-- Enemy stepper

stepEnemy = movePad 0 .> spure clamp

movePad :: Float -> Step [GameObject] e GameObject GameObject
movePad previousMomentumVector = step $ \_ dt gos _ pad ->
  let ball           = head gos
      heading        = (x . position $ ball) - (x . position $ pad)
      chaseVector    = enemySpeed * heading
      momentumVector = previousMomentumVector + enemyMomentum * heading * dt
      vx             = chaseVector * dt + momentumVector
   in (translate (vec2 vx 0) pad, movePad momentumVector)


-- Player stepper

stepPlayer = sfold movePlayer .> spure clamp

movePlayer = mconcat
  [ swhen MoveLeft  $ movePlayer' (vec2 (-playerSpeed) 0)
  , swhen MoveRight $ movePlayer' (vec2   playerSpeed  0)
  ]

movePlayer' :: Vector2 -> Step s e GameObject GameObject
movePlayer' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, movePlayer' dir)

clamp :: GameObject -> GameObject
clamp go =
  let p' = vec2 (clamp' x sx (1 - sx)) y
      (Vector2 x y) = position go
      clamp' x a b
        | x < a = a
        | x > b = b
        | otherwise = x
      (Vector2 sx _) = gameObjectSize go
   in setPosition p' go