content: -- |
  -- Copyright  : (c) Ivan Perez & Henrik Nilsson, 2014.
  -- License    : See LICENSE file.
  -- Maintainer : Ivan Perez <ivan.perez@keera.co.uk>
  --
  -- Game objects and collisions.
  module Objects where
  
  -- External imports
  import Data.VectorSpace
  
  -- Internal imports (general purpose)
  import Data.Extra.Num
  import Physics.TwoDimensions.Collisions
  import Physics.TwoDimensions.Dimensions
  import Physics.TwoDimensions.Physics
  
  -- Internal imports
  import Constants
  
  -- * Objects
  
  type ObjectName = String
  
  -- | Objects have logical properties (ID, kind, dead, hit), shape properties
  -- (kind), physical properties (kind, pos, vel, acc) and collision properties
  -- (hit, 'canCauseCollisions', energy, displaced).
  data Object = Object { objectName           :: ObjectName
                       , objectKind           :: ObjectKind
                       , objectPos            :: Pos2D
                       , objectVel            :: Vel2D
                       , objectAcc            :: Acc2D
                       , objectDead           :: Bool
                       , objectHit            :: Bool
                       , canCauseCollisions   :: Bool
                       , collisionEnergy      :: Double
                       , displacedOnCollision :: Bool       -- Theoretically,
                                                            -- setting cE == 0
                                                            -- should suffice.
                       }
    deriving (Show)
  
  type Objects   = [Object]
  
  -- | The kind of object and any size properties.
  --
  -- TODO: Use a GADT to separate these properties in two types and guarantee a
  -- proper correspondence in 'Object'.
  data ObjectKind = Ball   Double -- radius?
                  | Paddle Size2D
                  | Block  Energy Size2D
                  | Side   Side
    deriving (Show, Eq)
  
  type Energy = Int
  
  isBall :: ObjectKind -> Bool
  isBall (Ball _) = True
  isBall _        = False
  
  isBlock :: ObjectKind -> Bool
  isBlock Block {} = True
  isBlock _        = False
  
  isPaddle :: Object -> Bool
  isPaddle o = case objectKind o of
    (Paddle _) -> True
    _          -> False
  
  objShape :: Object -> Shape
  objShape obj = case objectKind obj of
      (Ball r)    -> Rectangle (p ^-^ (r, r)) (2 * r, 2 * r)
      (Paddle s)  -> Rectangle p s
      (Block _ s) -> Rectangle p s
      (Side   s)  -> sideToShape p s
  
    where
  
      p = objectPos obj
      width'  = gameWidth
      height' = gameHeight
      d = collisionErrorMargin
      sideToShape p TopSide    = Rectangle (p ^-^ (d, d)) (width' + 2 * d, d)
      sideToShape p LeftSide   = Rectangle (p ^-^ (d, d)) (d, height' + 2 * d)
      sideToShape p RightSide  = Rectangle (p ^-^ (0, d)) (d, height' + 2 * d)
      sideToShape p BottomSide = Rectangle (p ^-^ (d, 0)) (width' + 2 * d, d)
  
  -- * Collisions
  type Collisions = [Collision]
  
  -- | A collision is a list of objects that collided, plus their velocities as
  -- modified by the collision.
  --
  -- Take into account that the same object could take part in several
  -- simultaneous collisions, so these velocities should be added (per object).
  data Collision = Collision
      { collisionData :: [(ObjectName, Vel2D)] } -- ObjectId x Velocity
    deriving Show
  
  -- | Detects a collision between one object and another regardless of
  -- everything else
  --
  -- FIXME: should we use the last known positions? Or should velocities suffice?
  detectCollision :: Object -> Object -> Maybe Collision
  detectCollision obj1 obj2
    | overlap obj1 obj2 = Just (collisionResponseObj obj1 obj2)
    | otherwise         = Nothing
  
  overlap :: Object -> Object -> Bool
  overlap obj1 obj2 = overlapShape (objShape obj1) (objShape obj2)
  
  collisionSide :: Object -> Object -> Side
  collisionSide obj1 obj2 = shapeCollisionSide (objShape obj1) (objShape obj2)
  
  collisionResponseObj :: Object -> Object -> Collision
  collisionResponseObj o1 o2 =
      Collision $
        map objectToCollision [(o1, side, o2), (o2, side', o1)]
  
    where
  
      side  = collisionSide o1 o2
      side' = oppositeSide side
  
      objectReacts o = collisionEnergy o > 0 || displacedOnCollision o
  
      objectToCollision (o, s, o') =
        ( objectName o
        , correctVel
            (objectVel o ^+^ (velTrans *^ objectVel o'))
            (collisionEnergy o)
            s
        )
  
      correctVel (vx, vy) e TopSide    = (vx, ensurePos (vy * (-e)))
      correctVel (vx, vy) e BottomSide = (vx, ensureNeg (vy * (-e)))
      correctVel (vx, vy) e LeftSide   = (ensureNeg (vx * (-e)), vy)
      correctVel (vx, vy) e RightSide  = (ensurePos (vx * (-e)), vy)
  