{-# 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 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
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 =
GTSideOut
| GTBaseOut
| GTGoal
| GTOffsite
| GTQuit
| GTFreeze
| GTBallInPlay
| GTTakePossession
| GTRunGame
| GTWaitKickOff
deriving (Show, Eq, Ord)
data GameMsgParam =
GPTeamPosition Team Position2 Time Bool -- Team who gets the ball on sideout, foul or offsite,
-- position and time of event and whistle flag
deriving (Eq)
instance Show GameMsgParam where
-- show (GPTeam x) = "Team " ++ show x
show (GPTeamPosition team (Point2 x y) t _) = "TeamPosition " ++ show team ++ ", pos=(" ++ show x ++ ", " ++ show y ++ ") " ++ show t
-- show (GPNothing) = "Nothing"
type GameStateParam = GameMsgParam
type GameMessage = (GameTransition, GameMsgParam)
-- *************************************************************************
--
-- General Types and Helper Functions
--
-- *************************************************************************
type Collisions = [ObjId]
isBallMessage mb = case mb of BallMessage _ -> True; _ -> False
isPhysicalPlayerMessage mb = case mb of PlayerMessage (PhysicalPlayerMessage _) -> True; _ -> False
isTacticalPlayerMessage mb = case mb of PlayerMessage (TacticalPlayerMessage _) -> True; _ -> False
isGameMessage mb = case mb of GameMessage _ -> True; _ -> False
fromBPWho (BPWho x _) = x