module Lineup where
import Debug.Trace
import Data.List
import Data.Maybe
import Data.Ord
import FRP.Yampa
import FRP.Yampa.Geometry
import Object
import ObjectBehaviour
import Message
import AL
import Global
import BasicTypes
import Helper
import States
import Physics
lineupKickoff :: Param -> ALOut -> Time -> Team -> Int -> Int -> (ALOut, ALObj)
lineupKickoff param alout time possession scoreHome scoreAway =
let (homeOos, homeObjs, maybeHomeKickers) = lineupKickoffTeam param alout Home (possession == Home)
(awayOos, awayObjs, maybeAwayKickers) = lineupKickoffTeam param alout Away (possession == Away)
(kicksOff, kickedTo) = if maybeHomeKickers == Nothing then
fromJust maybeAwayKickers
else fromJust maybeHomeKickers
bid = ballId alout
gid = gameId alout
(ballOos, ballObjs) = lineupKickoffBall param bid kicksOff time
(gameOos, gameObjs) = lineupKickoffGame param gid time possession scoreHome scoreAway
in
#if DEBUG_MODE
trace ("Lineup durchgeführt" ++
show ((ballOos `appendAL` gameOos `appendAL` homeOos `appendAL` awayOos)) ++
show "Home=" ++ show (map fst $ assocsAL homeObjs) ++
show "Away=" ++ show (map fst $ assocsAL awayObjs)) $
#endif
(ballOos `appendAL` gameOos `appendAL` homeOos `appendAL` awayOos,
ballObjs `appendAL` gameObjs `appendAL` homeObjs `appendAL` awayObjs)
-- *************************************************************************
--
-- Player lineups
--
-- *************************************************************************
-- returns the lineup for given team on kickoff, depending on whether team
-- kicks off or nor, and also the player who has the ball on kickoff (if any)
lineupKickoffTeam :: Param -> ALOut -> Team -> Bool -> (ALOut, ALObj, Maybe (ObjId, ObjId))
lineupKickoffTeam param oos team kicksoff =
let players = (filterAL ((== team) . fst3 . oosTeamInfo) .
mapAL (ooObsObjState . snd) .
filterAL isPlayerOO) oos
sorted = fromAssocs $
sortBy (\(_, oos) (_, oos') ->
comparing dist oos oos') $
assocsAL players
(kicksOffPlId, kicksOffPl) = sorted `at` 0
(kickedToPlId, kickedToPl) = sorted `at` 1
kickOffSpot = Point2 (pPitchWidth param / 2) (pPitchLength param / 2)
dist oos = distance (basePos oos) kickOffSpot
basePls = if kicksoff then deleteAL kicksOffPlId $
deleteAL kickedToPlId players
else players
(baseOuts, baseObjs) = mkBase param team basePls
(kicksOut, kicksObjs) = if kicksoff then mkObjs param team
(kicksOffPlId, kicksOffPl)
(kickedToPlId, kickedToPl)
else (emptyAL, emptyAL)
in (baseOuts `appendAL` kicksOut,
baseObjs `appendAL` kicksObjs,
if kicksoff then Just (kicksOffPlId, kickedToPlId)
else Nothing
)
isPlayerOO (ObjOutput {ooObsObjState = OOSPlayer {}}) = True
isPlayerOO _ = False
mkBase param team oos =
(mapAL (mkStandardPlayerObjOutput . snd) oos,
mapAL (uncurry (mkStandardPlayerObject param team)) oos)
mkObjs param team (fromId, fromPl) (toId, toPl) =
let toOut = mkKickedToPlayerObjOutput param team toPl
toObj = mkKickedToPlayerObject param toId team toPl
fromOut = mkKicksOffPlayerObjOutput param team fromPl
fromObj = mkKicksOffPlayerObject param fromId team fromPl
in (fromAssocs [(toId, toOut), (fromId, fromOut)],
fromAssocs [(toId, toObj), (fromId, fromObj)])
basePos = piBasePosDefense. oosPlayerInfo
kicksOffPosition param team
-- | team == Home = Point2 42 52 -- basierend auf 80, 96 muss man noch verformeln
-- | team == Away = Point2 38 44
| team == Home = Point2 (pPitchWidth param / 2 + 2) (pPitchLength param / 2 + 1)
| team == Away = Point2 (pPitchWidth param / 2 - 2) (pPitchLength param / 2 - 1)
kickedToPosition param team
-- | team == Home = Point2 35 50
-- | team == Away = Point2 45 46
| team == Home = Point2 (pPitchWidth param / 2 - 5) (pPitchLength param / 2)
| team == Away = Point2 (pPitchWidth param / 2 + 5) (pPitchLength param / 2)
----------------------------------------------------------------------------------
--
-- create ObjOutput for player
--
----------------------------------------------------------------------------------
mkpoo :: Position2 -> ObsObjState -> ObjOutput
mkpoo pos oos = ObjOutput
oos {oosPos = pos .+! 0}
NoEvent NoEvent []
mkStandardPlayerObjOutput :: ObsObjState -> ObjOutput
mkStandardPlayerObjOutput oos = mkpoo (basePos oos) oos
mkKickedToPlayerObjOutput param = mkpoo . kickedToPosition param
mkKicksOffPlayerObjOutput param = mkpoo . kicksOffPosition param
----------------------------------------------------------------------------------
--
-- create Object for player
--
----------------------------------------------------------------------------------
mkpo :: Param -> ObjId -> ObsObjState -> Position2 -> BasicState -> Angle -> Object
mkpo param oid oos pos pbsInit angle0 =
maker param
oid
0
pos
(vector3 0 0 0)
angle0
(oosSelected oos)
False --(oosDesignated oos)
(oosTeamInfo oos)
(oosPlayerInfo oos)
pbsInit
NoFoot
(if (== Goalie) . piPlayerRole . oosPlayerInfo $ oos then TSGoalieWaitingForKickOff
else if ai then TSWaitingForKickOff else TSNonAIKickingOff)
where ai = not $ oosSelected oos
playerRole (_,pr,_,_) = pr
maker = if ai then playerAI else player
mkStandardPlayerObject :: Param -> Team -> ObjId -> ObsObjState -> Object
mkStandardPlayerObject param team oid oos =
mkpo param oid oos (basePos oos) PBSNoBall (if team == Home then 3*pi/2 else pi/2)
mkKickedToPlayerObject param oid team oos =
mkpo param oid oos (kickedToPosition param team) PBSNoBall (if team == Home then 0 else pi)
mkKicksOffPlayerObject param oid team oos =
mkpo param oid oos (kicksOffPosition param team) PBSInPossession (if team == Home then pi else 0)
-- *************************************************************************
--
-- Ball lineup
--
-- *************************************************************************
lineupKickoffBall :: Param -> ObjId -> ObjId -> Time -> (ALOut, ALObj)
lineupKickoffBall param ballId playerId t0 =
let (_, bobjs, boos) = mkBallInPossession param
ballId
playerId
t0
False
playerId
(pitchCenter param .+! 0)
(vector3 0 0 0)
[]
in (fromAssocs [(ballId, boos)],
fromAssocs [(ballId, bobjs)])
-- *************************************************************************
--
-- Game lineup
--
-- *************************************************************************
lineupKickoffGame :: Param -> ObjId -> Time -> Team -> Int -> Int -> (ALOut, ALObj)
lineupKickoffGame param oid time possession scoreHome scoreAway =
let goos = ObjOutput
(OOSGame time
(scoreHome, scoreAway)
(GSKickOff, GPTeamPosition possession (pitchCenter param) time True)
possession
(Point3 (-10) (-10) 0))
NoEvent
NoEvent
[]
gobj = game param oid possession scoreHome scoreAway time
in (fromAssocs [(oid, goos)],
fromAssocs [(oid, gobj)])