{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

module Message

where

import FRP.Yampa
import FRP.Yampa.Geometry
import Physics
import BasicTypes

type Message = (ObjId, MessageBody)

data MessageBody =
    BallMessage BallMessage
  | PlayerMessage PlayerMessage
  | GameMessage GameMessage
 deriving (Eq, Show)


-- *************************************************************************
--
-- Ball Messages
--
-- *************************************************************************

data BallMsgParam =
    BPWho ObjId Time                 -- player currently touching the ball and when he touched it
  | BPInit (Vector3 Double) ObjId  -- starting speed and last player to touch the ball
  | BPOutOfPlay Team OutOfPlay Position2 ObjId -- team to throw in, type of outofplay (throw in,
                                   -- kick off, corner, free kick) and last player to touch
                                   -- the ball
 deriving Eq

instance Show BallMsgParam where
  show (BPWho x t) = "BWho " ++ show x ++ " " ++ show t
  show (BPInit _ x) = "BPInit " ++ show x
  show (BPOutOfPlay team oop pos oid) = "BPOOP " ++ show team ++ " "
                                                 ++ show oop ++ " " ++ show pos
                                                 ++ " " ++ show oid
type BallStateParam = BallMsgParam
type BallMessage = (BallTransition, BallMsgParam)
data BallTransition =
    BTGained
  | BTLost
  | BTCollisionB
  | BTOutOfPlay
  | BTGainedOOP
  | BTLostOOP
  | BTGainedGoalie
 deriving (Show, Eq, Ord)


-- *************************************************************************
--
-- Player Messages
--
-- *************************************************************************

data PlayerMessage =
    PhysicalPlayerMessage PhysicalPlayerMessage
  | TacticalPlayerMessage TacticalPlayerMessage
  deriving (Show, Eq)

data ReleaseType = RTHigh | RTLow | RTNothing
  deriving (Show, Eq)

data BasicMsgParam =
    BSPNothing
  | BSPWhoAndWhen ObjId Time
  | BSPUnstun Time

      -- duration of key pressed, type of kick
  | BSPRelease Time ReleaseType
  | BSPPass Time ReleaseType (Maybe ObjId)  -- optional: pass receiver, if Nothing pass to designated
  | BSPShoot Velocity3
  deriving (Show, Eq)

type BasicStateParam = BasicMsgParam

type PhysicalPlayerMessage = (PhysicalPlayerTransition, BasicMsgParam)
data PhysicalPlayerTransition =
    PPTTakeMe
  | PPTLoseMe
  | PPTStun
  | PPTUnStun
  | PPTCollisionP
  | PPTPrepareThrowIn
    --  | PPTThrowIn
 deriving (Show, Eq, Ord)

--instance Show Position3
--  where show (Point3 x y z) = "(" ++ show x ++ ", " ++ show y ++ ", " ++ show z ++ ")"

data TacticalStateParam = TacticalStateParam {
    tspDesiredPos    :: Maybe Position2
   ,tspDesiredVector :: Maybe Velocity3
   ,tspKicked        :: Bool           -- true when player has kicked the ball (necessary for rendering)
   ,tspPlayerId      :: Maybe ObjId   -- e.g. for covering another player
   ,tspDirection     :: Maybe Angle   -- direction where player is looking
   ,tsKickType       :: Maybe ReleaseType
   ,tsTime           :: Maybe Time    -- not yet in use, can for instance track the time when
                                        -- state was entered...
} deriving (Show, Eq)

tspNull :: TacticalStateParam
tspNull = TacticalStateParam Nothing
                             Nothing
                             False
                             Nothing
                             Nothing
                             Nothing
                             Nothing :: TacticalStateParam

type TacticalPlayerMessage = (TacticalPlayerTransition, TacticalStateParam)
data TacticalPlayerTransition =
    TPTWait
  | TPTCover
  | TPTHoldPosition
  | TPTMoveTo
  | TPTMoveToThrowIn
  | TPTIntercept
  | TPTDropInterception
  | TPTWaitForThrowIn
  | TPTAimThrowIn
  | TPTReposition
  | TPTKickedOff
  | TPTWaitForKickOff
  | TPTDesignateReceiver
  | TPTFreeze
  | TPTSwitchControl
  | TPTKickTowards
  | TPTTendGoal
 deriving (Show, Eq)

instance Ord TacticalPlayerTransition where
  x < y = translate x < translate y
            where
               translate TPTWaitForKickOff    = 5 :: Integer
               translate TPTWait              = 10
               translate TPTMoveTo            = 20
               translate TPTHoldPosition      = 30
               translate TPTCover             = 40
               translate TPTIntercept         = 50
               translate TPTDropInterception  = 60
               translate TPTWaitForThrowIn    = 70
               translate TPTMoveToThrowIn     = 80
               translate TPTAimThrowIn        = 90
               translate TPTReposition        = 100
               translate TPTKickedOff         = 200
               translate TPTDesignateReceiver = 2
               translate TPTFreeze            = 210
               translate TPTSwitchControl     = 215
               translate TPTKickTowards       = 216
               translate TPTTendGoal          = 10

  x <= y  = x == y || x < y
  x > y   = not $ x < y
  x >= y  = x == y || x > y
  min x y = if x < y then x else y
  max x y = if x > y then x else y


-- *************************************************************************
--
-- Game Messages
--
-- *************************************************************************

data GameTransition =
    GTOutOfPlay
  | GTGoal
  | GTOffsite
  | GTQuit
  | GTFreeze
  | GTBallInPlay
  | GTTakePossession
  | GTRunGame
  | GTWaitKickOff
  | GTCheckOffsite
  | GTNoOffsite
 deriving (Show, Eq, Ord)

data GameMsgParam =
    GPTeamPosition Team        -- Team who gets the ball on sideout or who passed the ball on OffsitePending
                   ObjId       -- Player who passed the ball on OffsitePending
                   [(Team, ObjId, Position)] -- Position of players on passing (for OffsitePending)
                   Position2   -- Position of event
                   Time        -- Time of event
                   Bool        -- Whistle flag
                   OutOfPlay
 deriving (Eq)

instance Show GameMsgParam where
  show (GPTeamPosition team oid _ (Point2 x y) t _ _) =
      "T=" ++ show team ++ ",P="++show oid++",p=(" ++ show x ++ ", " ++ show y ++ ") " ++ show t

type GameStateParam = GameMsgParam
type GameMessage = (GameTransition, GameMsgParam)


-- *************************************************************************
--
-- General Types and Helper Functions
--
-- *************************************************************************

type Collisions = [ObjId]

isBallMessage :: MessageBody -> Bool
isBallMessage mb = case mb of BallMessage _ -> True; _ -> False
isPhysicalPlayerMessage :: MessageBody -> Bool
isPhysicalPlayerMessage mb = case mb of PlayerMessage (PhysicalPlayerMessage _) -> True; _ -> False
isTacticalPlayerMessage :: MessageBody -> Bool
isTacticalPlayerMessage mb = case mb of PlayerMessage (TacticalPlayerMessage _) -> True; _ -> False
isGameMessage :: MessageBody -> Bool
isGameMessage mb = case mb of GameMessage _ -> True; _ -> False

fromBPWho :: BallMsgParam -> ObjId
fromBPWho (BPWho x _) = x