{-# LANGUAGE Arrows #-}

module GameLoop where

import Debug.Trace

import FRP.Yampa
import FRP.Yampa.Geometry
import Object
import Message
import AL
import Global
import BasicTypes
import Helper
import States
import Lineup
 
gameLoop :: Param -> ALOut -> ALObj -> SF GameInput ALOut
gameLoop param init' objs0 =
  switch (process init' objs0) $
     \(time', possession, scoreHome, scoreAway) ->
#if DEBUG_MODE
        trace ("Achtung Init: " ++ show init') $
#endif
        uncurry (gameLoop param)
                (lineupKickoff param init' time' possession scoreHome scoreAway)

process :: ALOut -> ALObj -> SF GameInput (ALOut, Event (Time, Team, Int, Int))
process init' objs0 = proc input -> do
    ticker <- repeatedly 0.3 iterateTimerEvents -< ()
    timerEvent <- accum TimerCalculateAwayAI -< ticker
    rec
        oos <- core init' objs0 -< ((timerEvent, input), oos)
        let kickOffEvent = case ((gameOO . elemsAL) oos) of
             OOSGame gTime (gScoreHome, gScoreAway) (GSGoal, GPTeamPosition gTeam _ _ _ _ _ _) _ _ ->
                 Event (gTime, (otherTeam gTeam), gScoreHome + homeAdder gTeam, gScoreAway + awayAdder gTeam)
             _ -> NoEvent
    returnA -< (oos, kickOffEvent)
    where
        homeAdder gTeam = if gTeam == Home then 1 else 0
        awayAdder gTeam = if gTeam == Away then 1 else 0

gameOO :: [ObjOutput] -> ObsObjState
gameOO [] = error "GameLoop.hs/gameOO: No Game in Object Output"
gameOO (o:os) =
    case o of
        ObjOutput oog@(OOSGame {}) _ _ _ -> oog
        _ -> gameOO os


iterateTimerEvents :: TimerEvent -> TimerEvent
iterateTimerEvents TimerCalculateHomeAI = TimerCalculateAwayAI
iterateTimerEvents TimerCalculateAwayAI = TimerCalculateHomeAI


-- rather more complex core, only necessary if non-static objects are needed
-- (e.g. trigger objects)
core :: ALOut -> ALObj -> SF (Input, ALOut) (ALOut)
core init' objs = proc (input, al) -> do
      al' <- iPre init' -< al
      res <- core' objs -< (input, al')
      returnA -< res

core' :: ALObj -> SF (Input, ALOut) (ALOut)
core' objs = proc (input, al) -> do
      res <- dpSwitch route objs (arr killAndSpawn >>> notYet) (\sfs' f -> core' (f sfs')) -< (input, al)
      returnA -< res

killAndSpawn :: ((Input, ALOut), ALOut)
             -> Event (ALObj -> ALObj)
killAndSpawn (_, oos) =
  foldl (mergeBy (.)) noEvent events
  where
    events :: [Event (ALObj -> ALObj)]
    events = [ mergeBy (.)
                      (fmap (foldl (.) id . map (insertAL k))
                            (ooSpawnReq oo))
                      (ooKillReq oo `tag` (deleteAL k))
             | (k, oo) <- assocsAL oos ]

route :: (Input, ALOut) -> AL ObjId sf -> AL ObjId (ObjInput, sf)
route (input, oos) = {-# SCC "route" #-}
  mapAL (\(oid, obj) -> (ObjInput (getObjMessages oid messages, getObjMessages oid collisions) gameState input, obj))
       where
         messages = collectMessages oos

         AL kooss = mapAL (\(_,o) -> ooObsObjState o) oos
         collisions = collect (hits kooss)

         gameState = elemsAL . mapAL (\(oid', obj') -> vsFromObjOutput oid' obj') $ oos

         collectMessages :: ALOut -> [(ObjId, [MessageBody])]
         collectMessages = collect . concat . elemsAL . mapAL (ooMessages . snd)

         getObjMessages :: ObjId -> [(ObjId, [a])] -> [a]
         getObjMessages oid events =
            case lookup oid events of
                Just ms -> ms
                Nothing -> []

hits :: [(ObjId, ObsObjState)] -> [(ObjId, ObjId)]
hits = {-# SCC "hits" #-}
  map createMessage . mirror . hitsAux
  where

    createMessage (k,k',_,_) = (k, k')

    hitsAux [] = []
    -- Check each object 'State' against each other
    hitsAux ((k,oos):kooss) =
        [ (k, k',oos,oos') | (k', oos') <- kooss, oos `hit` oos' ]
        ++ hitsAux kooss

    hit :: ObsObjState -> ObsObjState -> Bool
    OOSPlayer {oosPos = p1} `hit` OOSPlayer {oosPos = p2} = distance p1 p2 < 3.0
    OOSPlayer {oosPos = p1} `hit` OOSBall {oosPos = p2} = distance p1 p2 < 1.4
    OOSBall {oosPos = p1} `hit` OOSPlayer {oosPos = p2} = distance p1 p2 < 1.4
    _ `hit` _ = False

    mirror [] = []
    mirror ((a,b,c,d):xs) = (a,b,c,d):(b,a,d,c):mirror xs