{-# LANGUAGE Arrows, FlexibleInstances #-}

module ObjectBehaviour -- (ball, ballInPossession, player, playerAI, game)
where

import Debug.Trace

import GHC.Exts
import Data.List
import Data.Maybe
import Control.Monad (guard)
--import Graphics.UI.SDL (Pixel)

import FRP.Yampa
import FRP.Yampa.Geometry

import Data.FSM

import Physics
import Object
import Parser
import Command
import Message
import PlayerFSM
import BallFSM
import GameFSM
import States
import Helper
import Global
import BasicTypes
import AI
import Rules

-- *************************************************************************
--
-- Object: Ball
--
-- *************************************************************************

fly :: Param -> ObjId -> ObjId -> Time -> Position3 -> Velocity3 -> Acceleration3 -> Collisions
       -> SF ObjInput (ObjOutput, Event (Param, ObjId, ObjId, Time, Position3, Velocity3, Acceleration3, Collisions))
fly param me lpInit t0 p0 v0 acc initColls = proc (ObjInput {oiGameInput = (_, (t1,_)), oiMessages = (mi, colls), oiGameState = vss}) -> do
-- models basic physics of a ball in free flight (speed, gravity, friction)
-- if ball is longer in free flight (either because it went out of bounds (tbd) or
-- because the ball is taken up and controlled by a player), the SF kills itself
-- and respawns as a corresponding SF

     v <- (v0 ^+^) ^<< integral -< acc
     p <- (p0 .+^) ^<< integral -< v

     bounced <- edge -< point3Z p + pEps param < pGround param
     stopped <- edge -< sameDirection param (project v) (project acc)

     -- drop redundant collisions
     (collisions, _) <- ballCollisionSF initColls -< colls

     let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi

     let mcs =
#if DEBUG_MODE
          trace ("__StMsg__Ball__Msg__" ++ show (ms ++ collisions))
#endif
          (ms ++ collisions)

     (bs@(st',stParam), msOut') <- freeBallSF param (BPWho lpInit t0) -< ((BPWho me t1, vss), (Event mcs))

     let st =
#if DEBUG_MODE
          trace ("__StMsg__Ball__St__" ++ show (content st'))
#endif
           st'

     let lp = lastPlayer bs

     let msOut =
#if DEBUG_MODE
           trace ("Ball (Free) messages: " ++ show msOut' ++ show (lineCrossedMsgs param t1 (content st) p lpInit vss))
#endif
           (msOut' ++ lineCrossedMsgs param t1 (content st) p lpInit vss)

     gainedControl <- edge -< content st `elem` [BSControlled, BSControlledGoalie]
     outOfPlay <- edge -< content st == BSOutOfPlay
     let goalieHasGained = content st == BSControlledGoalie

     returnA -< (ObjOutput (OOSBall p v (isEvent bounced && vector3Z v < (-5)) ((content st), stParam))
                           (gainedControl `merge` outOfPlay)
                           (                                                                                           -- what about cNext??
                               (gainedControl `tag` [snd3 $ mkBallInPossession param me (fetchPlayer stParam) t1
                                                                               goalieHasGained lp (p .-^ vector3 (-2) (-2) 0) v colls])
                               `merge`
                               (outOfPlay `tag` [let BPOutOfPlay team oop pos _ = stParam in ballOutOfPlay param me lp team oop pos])
                            )
                           msOut,
                 tag (merge bounced stopped) $
                     let z  = max (point3Z p) (pGround param)
                         vz = if z == pGround param then (-0.7) * vector3Z v else vector3Z v
                         (vx, vy) = event (vector3X v, vector3Y v) (const (0,0)) stopped
                     in (param, me, lp, t1, (Point3 (point3X p) (point3Y p) z), vector3 vx vy vz, acc, initColls))
  where fetchPlayer (BPWho p _) = p

ball :: (Param, ObjId, ObjId, Time, Position3, Velocity3, Acceleration3, Collisions) -> SF ObjInput ObjOutput
ball (param, me, lpInit, t0, pos, v, acc, initColls) = dSwitch (fly param me lpInit t0 pos v acc initColls) ball


ballInPossession :: Param -> ObjId -> ObjId -> Time -> Bool -> ObjId -> Collisions-> SF ObjInput ObjOutput
ballInPossession param me plr t0 goalieHasGained _ initColls = {-# SCC "ballIP" #-}
  proc (ObjInput {oiGameInput = (_, (t1,_)), oiMessages = (mi, colls), oiGameState = vss}) -> do

     -- drop redundant collisions
     (collisions, cNext) <- ballCollisionSF initColls -< colls

     let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi
     let mcs =
#if DEBUG_MODE
          trace ("__StMsg__Ball__Msg__" ++ show (ms ++ collisions))
#endif
          (ms ++ collisions)


     ((st',stParam), ems) <- (controlledBallSF param goalieHasGained) (BPWho plr t0) -< ((BPWho me t1, vss), (Event mcs))

     let st =
#if DEBUG_MODE
          trace ("__StMsg__Ball__St__" ++ show (content st'))
#endif
           st'

     let stParam' =
#if DEBUG_MODE
          trace ("BallParam (Poss): " ++ show stParam)
#endif
          stParam

     currPlayer <- iPre plr -< fetchPlayer stParam'
     let Just playerVS = getObjVS currPlayer vss

     -- ball is either on the left or right foot of the player, ball position will be
     -- adjusted accordingly
     let foot = case vsOnFoot playerVS of
          LeftFoot -> -(pi / 4)
          RightFoot -> pi / 4
          _ -> 0

     -- position and velocity of the ball are taken from the player's
     -- respective values
     let p = vsPos playerVS .-^ fromPolar3 (foot + pi + vsDir playerVS) 2.1 0
     let v = vsVel playerVS

     lostPossession <- edge -< content st == BSFree
     outOfPlay <- edge -< content st == BSOutOfPlay

     returnA -< ObjOutput (OOSBall p v False ((content st), stParam))
                           (lostPossession `merge` outOfPlay)
                           (
                               (lostPossession `tag` [snd3 $ mkBall (param, me, currPlayer, t1, p, (fetchVel stParam), (makeBreakVector (fetchVel stParam)), cNext)])
                               `merge`
                               (outOfPlay `tag` [let BPOutOfPlay team oop pos _ = stParam in ballOutOfPlay param me currPlayer team oop pos])
                           )
                          (ems ++ lineCrossedMsgs param t1 (content st) p currPlayer vss)
     where fetchPlayer (BPWho who _) = who

makeBreakVector :: Velocity3 -> Vector3 Velocity
makeBreakVector vel =
    let vel2 = project vel
        (theta, _) = toPolar (vector2X vel2) (vector2Y vel2)
        (theta', rho') = (normTheta (theta + pi), 3)
        vel2' = fromPolar theta' rho'
    in vector3 (vector2X vel2') (vector2Y vel2') (-10)

fetchVel :: BallMsgParam -> Vector3 Double
fetchVel (BPInit vel _) = vel
fetchVel _ = zeroVel

lineCrossedMsgs :: Param -> Time -> BallState -> (Point3 Double) -> ObjId -> [VisibleState] -> [Message]
lineCrossedMsgs param t _ pos1 lastPlr vss =
-- checks if ball crossed base, side or goal line and sends a corresponding
-- message to the game object
    let gameId_ = vsObjId $ fetchGameVS vss
        pos0 = vsPos . fetchBallVS $ vss
        (x0, y0)  = (point3X pos0, point3Y pos0)
        (x1, y1)  = (point3X pos1, point3Y pos1)
        xMax = pPitchWidth param
        yMax = pPitchLength param
        xBase = if x1 <= (pPitchWidth param) / 2 then 0 else pPitchWidth param
        yBase = if y1 <= 0 then 0 else (pPitchLength param)
        teamThrowingIn = otherTeam . vsTeam $ fetchVS vss lastPlr
        goalTeam = if y1 < 0 then Home else Away
    in if (x1 < 0 && x0 >= 0) || (x1 > xMax && x0 <= xMax) then
           [(gameId_, GameMessage (GTOutOfPlay, GPTeamPosition teamThrowingIn (-1) [] (Point2 x1 y1) t True OOPSideOut))]
       else if ((y1 < 0 && y0 >= 0) || (y1 > yMax && y0 <= yMax)) &&
               ((x1 < (xMax - pGoalWidth param) / 2) || (x1 > (xMax + pGoalWidth param) / 2)) then
                   [(gameId_, GameMessage (GTOutOfPlay, GPTeamPosition teamThrowingIn (-1) [] (Point2 xBase yBase) t True OOPBaseOut))]
       else if ((y1 < 0 && y0 >= 0) || (y1 > yMax && y0 <= yMax)) &&
               ((x1 >= (xMax - pGoalWidth param) / 2) && (x1 <= (xMax + pGoalWidth param) / 2))
               then [(gameId_, GameMessage (GTGoal, GPTeamPosition goalTeam (-1) [] (Point2 0 0) t True OOPKickOff))]
       else []

ballOutOfPlay :: Param -> ObjId -> ObjId -> Team -> OutOfPlay -> Position2 -> SF ObjInput ObjOutput
ballOutOfPlay param me lpInit team oopType pos = {-# SCC "ballOOP" #-}
  proc (ObjInput {oiGameInput = (_, (t1,_)), oiMessages = (mi, colls), oiGameState = vss}) -> do
-- -- what this does:
-- -- a.) as long as the ball is out of play, it's position is either the corresponding out-of-play spot
-- --     (kick off-, corner-positon or side-line position as long as not taken up by player), or
-- --     behind and above the player's head if it's a throw-in and the ball has been taken up by
-- --     a player (then the position changes when the player turns around)
-- -- b.) when the ball goes in play again, the SF kills itself and respawns as a
-- --     ball-SF
--      let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi
--      let mcs = trace ("Ball (Poss): " ++ show (ms ++ collisions)) (ms ++ collisions)
--      ((st,stParam), ems) <- controlledBallSF (BPWho player) -< ((BPWho me, vss), (Event mcs))

     -- drop redundant collisions
     (collisions, cNext) <- ballCollisionSF [] -< colls

     let ms = map (\(BallMessage msg) -> msg) $ filter isBallMessage mi
     let mcs =
#if DEBUG_MODE
          trace ("__StMsg__Ball__Msg__" ++ show (ms ++ collisions))
#endif
          (ms ++ collisions)
     (bs@(st',stParam), ems) <- outOfPlayBallSF param (BPOutOfPlay team oopType pos lpInit) -< ((BPWho me t1, vss), (Event mcs))

     let st =
#if DEBUG_MODE
          trace ("__StMsg__Ball__St__" ++ show (content st'))
#endif
           st'


     let lp = lastPlayer bs

     let Just playerVS = getObjVS lp vss

     controlled <- taggedEdge -< (content st == BSControlledOOP, 2.5)
     posZ <- hold 0 -< controlled

     -- position is above and behind player
     let posAdjust = if (content st) == BSControlledOOP then
                         vsPos playerVS .-^ fromPolar3 (vsDir playerVS) 3 (-posZ)
                     else pos .+! posZ

     backInPlay <- edge -< not $ content st `elem` [BSOutOfPlay, BSControlledOOP, BSChallenged]

     returnA -< ObjOutput (OOSBall posAdjust zeroVel False ((content st), stParam))
                          backInPlay
                          (backInPlay `tag` [snd3 $ mkBall (param, me, lp, t1, posAdjust,
                                                            fetchVel stParam,
                                                            makeBreakVector (fetchVel stParam),
                                                            cNext)])
                          ems


-- *************************************************************************
--
-- Object: PlayerAI (controlled by AI)
--
-- *************************************************************************

playerAI :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Angle -> Bool
            -> Bool -> TeamInfo -> PlayerInfo -> BasicState -> OnFoot -> TacticalState -> Object
playerAI param me t0 p0 v0 angle0 sel des ti pI pbsInit _ initState =
  proc (ObjInput {oiMessages = (mi, colls), oiGameState = vss, oiGameInput = (_,(t1,_))}) -> do
    let commands = []

    let tms =
#if DEBUG_MODE
          trace ("__StMsg__AI " ++ show me ++ "__Msg__" ++ show (convertTms mi))
#endif
          convertTms mi

    rec

      pdDefault <- iPre p0 -< pd --projectP pos

      ((st, stParam@(TacticalStateParam maybePd _ _ _ ovrwtDir _ _)), msOut)
                 <- tacticalPlayerSF param initState angle0 -< ((t1, me, vss, commands), Event tms)

      let isDesignated = elem (TPTDesignateReceiver, tspNull) tms
      let isSwitchControl = elem (TPTSwitchControl, tspNull) tms

      -- desired position comes either from tactical fsm (if tactical transition yielded
      -- new pd) or default pd that is usually the last player position
      let pd = fromMaybe pdDefault maybePd

      let msLocal = map snd $ filter ((me ==) . fst) $ filter (isPhysicalPlayerMessage . snd) msOut
      let msOther = filter (\(id_, m) -> not ((id_ == me) && isPhysicalPlayerMessage m)) msOut

      results@(ObjOutput oop@OOSPlayer{oosPos = pos, oosVel = vel, oosDir = angle } _ _ _)
                   <- playerCore param me t0 p0 v0 sel des ti pI pbsInit
                               -< (pd, False, ovrwtDir, t1, commands, (msLocal ++ mi, colls), vss)

      let rm = ooMessages results

      let oos = (ooObsObjState results) { oosTacticalState = (content st, stParam), oosDesignated = isDesignated }

    returnA -< results { ooMessages = msOther ++ rm,
                         ooObsObjState = oos,
                         ooKillReq = if isSwitchControl then Event () else NoEvent,
                         ooSpawnReq = if isSwitchControl
                            then Event [ player param
                                                 me
                                                 t0
                                                 (projectP pos)
                                                 vel
                                                 angle
                                                 False
                                                 False
                                                 ti
                                                 pI
                                                 (fst $ oosBasicState oop)
                                                 (oosOnFoot oop)
                                                 (if content st == TSWaitingForKickOff
                                                  then TSNonAIKickingOff
                                                  else TSNonAI) ]
                            else NoEvent }


-- *************************************************************************
--
-- Object: Player (controlled by human)
--
-- *************************************************************************

convertTms :: [MessageBody] -> [(TacticalPlayerTransition, TacticalStateParam)]
convertTms mi =  (sortWith fst (map (\(PlayerMessage (TacticalPlayerMessage tm_)) -> tm_) $ filter isTacticalPlayerMessage mi))

messageForNearestPlayer :: Param -> ObjId -> Team -> Position2 -> [Command] -> [VisibleState] -> (ObjId, MessageBody)
messageForNearestPlayer param npId myTeam myPos mc vss =
    (npId, if cmdTakeOver mc then
              tm (TPTSwitchControl, tspNull)
           else if cmdMoveForward mc then
              tm (TPTMoveTo,
                  TacticalStateParam (Just $ posNp .+^ vector2 0 adjust)
                  Nothing False Nothing Nothing Nothing Nothing)
           else if cmdMoveBackward mc then
              tm (TPTMoveTo,
                  TacticalStateParam (Just $ posNp .+^ vector2 0 ((-1)*adjust))
                  Nothing False Nothing Nothing Nothing Nothing)
           else if cmdMoveLeft mc then
              tm (TPTMoveTo,
                  TacticalStateParam (Just $ posNp .+^ vector2 adjust 0)
                  Nothing False Nothing Nothing Nothing Nothing)
           else if cmdMoveRight mc then
              tm (TPTMoveTo,
                  TacticalStateParam (Just $ posNp .+^ vector2 ((-1)*adjust) 0)
                  Nothing False Nothing Nothing Nothing Nothing)
           else if cmdMoveToGoal mc then
              tm (TPTMoveTo,
                  TacticalStateParam (Just goalPos)
                  Nothing False Nothing Nothing Nothing Nothing)
           else if cmdMoveToMe mc then
              tm (TPTMoveTo,
                  TacticalStateParam (Just myPos)
                  Nothing False Nothing Nothing Nothing Nothing)
           else
              tm (TPTDesignateReceiver, tspNull))

    where
        posNp = projectP . vsPos $ fetchVS vss npId
        adjust = if myTeam == Home then -20 else 20
        goalPos = if myTeam == Home then awayGoalCenter param else homeGoalCenter param

messageForTeamMate :: ObjId -> Team -> t -> [Command] -> [VisibleState] -> Maybe (ObjId, MessageBody)
messageForTeamMate me myTeam _ mc vss = do
    kickType <- getKickType mc
    bc <- fetchBallCarrier vss
    guard $ vsTeam bc == myTeam
    return (vsObjId bc, pm (PPTLoseMe, BSPPass 1 kickType (Just me)))

getKickType :: [Command] -> Maybe ReleaseType
getKickType mc =
    if cmdFlipMeLow mc then Just RTLow
    else if cmdFlipMeHigh mc then Just RTHigh
    else Nothing

player :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Angle -> Bool -> Bool
          -> TeamInfo -> PlayerInfo -> BasicState -> OnFoot -> TacticalState -> Object
player param me t0 p0 v0 angle0 sel des ti pI pbsInit _ initState =
  proc (ObjInput {oiGameInput = gi@(_,(t1,_)), oiGameState = vss, oiMessages = (mi, colls)}) -> do

    -- desired position is current mouse position
    (pd, commands) <- playerInput param -< gi

    -- mark designated receiver
    let myTeam = fst3 ti
    let npId = nearestAIPlayer myTeam vss pd

    let tms =
#if DEBUG_MODE
          trace ("__StMsg__AI " ++ show me ++ "__Msg__" ++ show (convertTms mi))
#endif
          convertTms mi

    let comMsgs = concatMap comToMsg commands

    rec

        pos' <- iPre p0 -< projectP pos
        oosBS' <- iPre pbsInit -< oosBS

        let markMsg = messageForNearestPlayer param npId myTeam pos' commands vss
        let teamMateMsg = messageForTeamMate me myTeam pos' commands vss


        ((st',stParam), _) <- tacticalNonAiSF initState -< ((t1, me, vss, commands), Event tms)

        let st =
#if DEBUG_MODE
               trace ("__StMsg__AI " ++ show me ++ "__St__" ++ show (content st'))
#endif
                st'

        let running = content st /= TSNonAIKickingOff

        -- player commands will be ignored before kickoff
        let pdAdjusted = if not running then p0 -- .+^ (vector2 (-0.0000001) 0)
                         -- only look, don't walk when preparing for throw in
                         else if oosBS' == PBSPrepareThrowIn then lookTo pos' pd
                              else pd

        let angleAdjusted = if not running then Just angle0 else Nothing

        results@(ObjOutput oop@OOSPlayer{oosPos = pos, oosVel = vel, oosDir = angle,
                                         oosBasicState = (oosBS, _)}
                           _
                           _ 
                           msgs)
            <- playerCore param me t0 p0 v0 sel des ti pI pbsInit
                -< (pdAdjusted, not (null comMsgs), angleAdjusted, t1, commands, (mi ++ comMsgs, colls), vss)

    let (switchAI, newAI) =
          if cmdTakeOver commands
              then (Event (),
--playerAI :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Angle -> Bool
--            -> Bool -> TeamInfo -> PlayerInfo -> BasicState -> TacticalState -> Object
                    Event [playerAI param
                                     me
                                     t0
                                     (projectP pos)
                                     vel
                                     angle
                                     False
                                     False
                                     ti
                                     pI
                                     oosBS
                                     (oosOnFoot oop)
                                     (if content st == TSNonAIKickingOff
                                      then TSWaitingForKickOff
                                      else
                                          if piPlayerRole pI == Goalie
                                              then TSTendingGoal
                                              else TSHoldingPosition)])

              else (NoEvent, NoEvent)

    let oos = (ooObsObjState results) { oosTacticalState = (content st, stParam) }

    returnA -< results {ooMessages = maybeToList teamMateMsg ++ markMsg:msgs,
                        ooObsObjState = oos,
                        ooKillReq = switchAI,
                        ooSpawnReq = newAI}


-- *************************************************************************
--
-- Core player logic, used by both AI- and user controlled player
--
-- *************************************************************************

bouncePower :: (VisibleState -> Velocity3) -> [VisibleState] -> [ObjId] -> Vector2 Velocity
bouncePower f vss =
  foldl' (^+^) (vector2 0 0) . map (project . f . fetchVS vss)

playerCore :: Param -> ObjId -> Time -> Position2 -> Velocity3 -> Bool -> Bool -> TeamInfo -> PlayerInfo -> BasicState
              -> SF (Point2 Double, Bool, Maybe Angle, Time, [Command], ([MessageBody], Collisions), [VisibleState]) ObjOutput
playerCore param me t0 p0 v0 sel des ti pI pbsInit =
  proc (pd, kicked, ovrwtDir, t1, commands, (mi, collsIn), vss) -> do
    -- desired position is current mouse position

    let pCollsIn = filter (isPlayer . fetchVS vss) collsIn

    -- check for new collisions; every new collision will be fed to the basicPlayerFSM,
    -- the subset of new player collisions is needed for the bouncing logic
    allCollisions <- playerCollisionSF [] -< collsIn
    pCollisions <- playerCollisionSF [] -< pCollsIn

    -- save the time of the last player collision
    pCollided <- taggedEdge -< (not (null pCollisions), t1)
    pCollTime <- hold t0 -< pCollided

    -- a collision only slows a player down for a given time
    -- after that, the usual motion logic starts again
    let inPlayerCollision = not (null pCollsIn) && t1 - pCollTime < pBouncingTime param

    -- during a collision, the total acc and vel of all the players involved
    -- are evenly divided between the "colliders"; this replaced the
    -- usual acc and vel for the time of the collision
    let adjust = 1 / (1 + fromIntegral (length pCollsIn))
    let accBounce = adjust *^ bouncePower vsAcc vss (me:pCollsIn)
    let velBounce = adjust *^ bouncePower vsVel vss (me:pCollsIn)

    toggled <- edge -< cmdToggleFoot commands
 
    rec
        let ad = ((20 *^ (pd .-. p)) ^-^ (10 *^ v))  -- Desired acceleration
        let acc = if inPlayerCollision then accBounce else limit (piPlayerAccMax pI) ad

        v <- integral >>> arr ((limit (piPlayerSpeedMax pI)) . ((project v0) ^+^))
                   -< residualAcc param acc v (piPlayerSpeedMax pI)
        p <- integral >>> arr (p0 .+^) -< if inPlayerCollision then velBounce else v

    let dirV = pd .-. p
    let dir = atan2 (vector2Y dirV) (vector2X dirV)

    let pms = map (\(PlayerMessage (PhysicalPlayerMessage pm')) -> pm') $ filter isPhysicalPlayerMessage mi
    let mcs =
#if DEBUG_MODE
         trace ("__StMsg__Tactical " ++ show me ++ "__Msg__ " ++ show (pms ++ allCollisions))
#endif
         (pms ++ allCollisions)

    ((st',stParam), ems) <- basicPlayerSF pbsInit t0 -< ((t1, me, vss), (Event mcs))

    let st =
#if DEBUG_MODE
           trace ("__StMsg__Tactical " ++ show me ++ "__St__" ++ show (content st'))
#endif
            st'

    let ems' =
#if DEBUG_MODE
         trace ("Messages Player " ++ show me ++ ": " ++ show ems)
#endif
         ems

    -- toggle between left and right foot
    possGained <- edge -< content st == PBSInPossession
    let initialFoot = possGained `tag` leftOrRightFoot p dirV (vsPos $ fetchBallVS vss)
    (foot, _) <- accumHoldBy switcher (NoFoot, False) -< myjoin initialFoot toggled


    returnA -< ObjOutput {
                   ooObsObjState = OOSPlayer (Point3 (point2X p) (point2Y p) 0)
                                             (vector3 (vector2X v) (vector2Y v) 0)
                                             (vector3 (vector2X acc) (vector2Y acc) 0)
                                             kicked
                                             sel
                                             des
                                             2
                                             ti
                                             pI
                                             (fromMaybe dir ovrwtDir)
                                             ((content st), stParam)
                                             (TSNonAI, tspNull)
                                             foot,
                   ooKillReq     = noEvent,
                   ooSpawnReq    = noEvent,
                   ooMessages    = ems'
               }

leftOrRightFoot :: Position2 -> Vector2 Double -> Position3 -> OnFoot
leftOrRightFoot pPlayer dirPlayer pBall =
    if isLeftFrom dirPlayer (projectP pBall .-. pPlayer) then LeftFoot else RightFoot

myjoin :: Event OnFoot -> Event () -> Event (OnFoot, Bool)
myjoin (Event NoFoot) _ = NoEvent
myjoin (Event x) NoEvent = Event (x, False)
myjoin NoEvent (Event ()) = Event (undefined, True)
myjoin NoEvent NoEvent = NoEvent
myjoin _ _ = NoEvent

switchFoot :: OnFoot -> OnFoot
switchFoot NoFoot = NoFoot
switchFoot RightFoot = LeftFoot
switchFoot LeftFoot = RightFoot

switcher :: (OnFoot, t) -> (OnFoot, Bool) -> (OnFoot, Bool)
switcher (_, _) (newF, False) = (newF, False)
switcher (oldF, _) (_, True) = (switchFoot oldF, False)

fetchBall :: [VisibleState] -> ObjId
fetchBall ((VSBall oid _ _ _ _):_) = oid
fetchBall (_:xs) = fetchBall xs


-- *************************************************************************
--
-- Object: Game
--
-- *************************************************************************

runRulesOnEvent :: Facts -> [VisibleState] -> RuleBase -> RuleBase -> TimerEvent -> [(ObjId, MessageBody)]
runRulesOnEvent facts vss trb_home trb_away te =
    runRules tps facts vss (if team == Home then trb_home else trb_away)
    where team = if te == TimerCalculateHomeAI then Home else Away
          tps = map vsObjId $ teamPlayers team vss

game :: Param -> ObjId -> Team -> Int -> Int -> Time -> Object
game param _ initialAttacker scoreHome scoreAway t0 =
  proc (ObjInput {oiGameInput = gi@(te, (t1,_)), oiGameState = vss, oiMessages = (mi, _)}) -> do
    commands <- gameKeysSF -< gi

    let gms =
#if DEBUG_MODE
         trace ("__StMsg__Game__Msg__" ++ show (map (\(GameMessage gm) -> gm) $ filter isGameMessage mi))
#endif
         (map (\(GameMessage gm) -> gm) $ filter isGameMessage mi)

    rec
        freezeAttacker <- iPre initialAttacker -< attacker

        let comMsgs = if cmdQuit commands then [(GTQuit, GPTeamPosition freezeAttacker (-1) [] (Point2 0 0) t1 True InPlay)]
                      else if cmdFreeze commands then [(GTFreeze, GPTeamPosition freezeAttacker (-1) [] (Point2 0 0) t1 False InPlay)]
                      else []

        -- hack!! should not be 100 but real init player
        ((st', stParam@(GPTeamPosition attacker _ _ _ _ _ _)), msOut) <- gameSF param (GPTeamPosition initialAttacker 100 [] (Point2 0 0) t0 True OOPKickOff) -< (vss, Event (comMsgs ++ gms))

        let st =
#if DEBUG_MODE
               trace ("__StMsg__Game__St__" ++ show (content st'))
#endif
                st'

        let teamAtMove = if fromEvent te == TimerCalculateHomeAI then Home else Away
        let semNet = deriveFacts param t1 attacker teamAtMove vss

    let msg = event [] (runRulesOnEvent semNet vss (pRuleBaseHome param) (pRuleBaseAway param)) te

    let totalMsgOut =
#if DEBUG_MODE
         trace ("Game messages: " ++ show (msOut ++ msg))
#endif
         msOut ++ msg


    returnA -< ObjOutput {
                   ooObsObjState = OOSGame t1     -- time
                                           (scoreHome, scoreAway) -- score
                                           (content st, stParam)
                                           attacker
                                           (Point3 0 0 0),
                   ooKillReq     = noEvent,
                   ooSpawnReq    = noEvent,
                   ooMessages    = totalMsgOut
               }

safePartition :: [a] -> ([a], [a])
safePartition [] = ([], [])
safePartition [a] = ([a], [])
safePartition (a:as) = ([a], as)

-- *************************************************************************
--
-- Convenient maker functions
--
-- *************************************************************************

mkBall :: (Param, ObjId, ObjId, Time, Position3, Velocity3, Acceleration3, Collisions) ->
          (ObjId, SF ObjInput ObjOutput, ObjOutput)
mkBall (param, me, lp, t0, pos, v, acc, initColls) =
        (me, ball (param, me, lp, t0, pos, v, acc, initColls),
         ObjOutput (OOSBall pos v False (BSFree, undefined)) NoEvent NoEvent [])

mkBallInPossession :: Param -> ObjId -> ObjId -> Time -> Bool -> ObjId -> Position3 -> Velocity3 ->
                      Collisions -> (ObjId, SF ObjInput ObjOutput, ObjOutput)
mkBallInPossession param me player' t0 goalieHasGained lp pos v initColls =
  (me, ballInPossession param me player' t0 goalieHasGained lp initColls,
   ObjOutput (OOSBall pos v False (BSControlled, BPWho player' t0)) NoEvent NoEvent [])

-- *************************************************************************
--
-- Various helper functions
--
-- *************************************************************************

residualAcc :: Param -> Acceleration2 -> Velocity2 -> Double -> Acceleration2
residualAcc param acc vel maxV =
    let accTheta = vector2Theta acc
        accRho   = vector2Rho acc
        velTheta = vector2Theta vel
        velRho   = vector2Rho vel
    in
        if (velRho + pEps param >= maxV) && (acc `sameDirAs` vel)  then
            fromPolar (normTheta $ if acc `isLeftFrom` vel then velTheta + pi else velTheta - pi)
--                    (accRho * abs (sin (accTheta - accRho))) -- häh???
                      (accRho * abs (sin (accTheta - velTheta)))
        else acc

ballCollisionSF :: Collisions -> SF Collisions ([BallMessage], Collisions)
ballCollisionSF init' = proc c1 -> do
    c2 <- iPre init' -< c1
    let cNext = c1 \\ c2
    let newColls = map (\c -> (BTCollisionB, BPWho c (-1))) cNext
    returnA -< (newColls, cNext)

playerCollisionSF :: Collisions -> SF Collisions [PhysicalPlayerMessage]
playerCollisionSF init' = proc c1 -> do
    c2 <- iPre init' -< c1
    let newColls = map (\c -> (PPTCollisionP, BSPWhoAndWhen c 0)) $ c1 \\ c2
    returnA -< newColls

tupelize :: [(a, b)] -> c -> [(a, (b, c))]
tupelize [] _ = []
tupelize ((x,y):xs) z = (x,(y,z)):tupelize xs z

taggedEdge :: SF (Bool, a) (Event a)
taggedEdge = proc (bool, a) -> do
    e <- edge -< bool
    returnA -< tag e a