{-# LANGUAGE FlexibleInstances #-}

module Helper

where

import Debug.Trace

import Data.Maybe
import Data.List
import Data.Ord
import Data.Function
import GHC.Exts

import FRP.Yampa
import FRP.Yampa.Geometry
import FRP.Yampa.Point2

import Object
import Message
import Command
import States
import Physics
import Global
import BasicTypes
import AL

-- *************************************************************************
--
-- Various geometric functions
--
-- *************************************************************************

spotToPoint (Spot x y) = Point2 x y
pointToSpot (Point2 x y) = Spot x y

distanceToSpot :: Spot -> Point2 Double -> Point2 Double -> Ordering
distanceToSpot (Spot x y) =
    comparing (distance (Point2 x y))

spotDistance (Spot x1 y1) p =
    distance (Point2 x1 y1) p


tm x = PlayerMessage $ TacticalPlayerMessage x
pm x = PlayerMessage $ PhysicalPlayerMessage x

otherTeam Home = Away
otherTeam Away = Home

lastPlayer ballState =
    case ballState of
        (_, BPWho oid _) -> oid
        (_, BPInit _ oid) -> oid
        (_, BPOutOfPlay _ _ _ oid) -> oid

teamMates me vss =
    let team = vsTeam $ fetchVS vss me
    in [p | p@(VSPlayer {}) <- vss, vsTeam p == team, vsObjId p /= me]

teamPlayers team vss = [p | p@(VSPlayer {vsTeam = team'}) <- vss, team' == team]

fetchGoalie team vss =
    head $ filter isGoalie $ teamPlayers team vss

isGoalie = (Goalie ==) . piPlayerRole . vsPlayerInfo

playerWithBall :: [VisibleState] -> Maybe ObjId
playerWithBall vss =
    case filter hasBall vss of
        [player] -> Just $ vsObjId player
        [] -> Nothing
        pls  -> error $ "Helper.hs/playerWithBall: too many players " ++ show (map vsObjId pls)

playerIsFree vss vs =
    let pos = vsPos vs
        team = vsTeam vs
        otherPlayers = teamPlayers (otherTeam team) vss
    in foldl' (\acc vso -> acc &&
                           distance pos (vsPos vso) > 5) True otherPlayers


homeValue param (Spot x y) =
  half x (pPositionFactorX param) (pPitchWidth param) +
    (pPitchLength param - y) * pPositionFactorY param

awayValue param (Spot x y) =
  homeValue param (Spot x (pPitchLength param - y))

half u factor max
   | u < (max / 2) = u * factor
   | otherwise = (max - u) * factor


bestFreePlayer param vss ballCarrier =
    let team = vsTeam ballCarrier
        me = vsObjId ballCarrier
        valFun = if team == Home then homeValue else awayValue
        freePlayers = filter (playerIsFree vss) $ teamMates me vss
    in if null freePlayers then Nothing
       else Just $ maximumBy (compare `on` (valFun param) . pointToSpot . projectP . vsPos) freePlayers

nearestNonAIPlayer team vss pos =
    let players = [p | p@(VSPlayer {}) <- vss, vsTeam p == team, fst (vsPTState p) == TSNonAI ]
        nearest = minimumBy (\pl1 pl2 -> closerToPoint pos (projectP $ vsPos pl1) (projectP $ vsPos pl2)) players
    in vsObjId nearest

nearestAIPlayer team vss pos =
    let players = [p | p@(VSPlayer {}) <- vss, vsTeam p == team, fst (vsPTState p) /= TSNonAI ]
        nearest = minimumBy (\pl1 pl2 -> closerToPoint pos (projectP $ vsPos pl1) (projectP $ vsPos pl2)) players
    in vsObjId nearest

nearestAIFieldPlayer team vss pos =
    let players = [p | p@(VSPlayer {}) <- vss, vsTeam p == team, fst (vsPTState p) /= TSNonAI,
                         (piPlayerRole . vsPlayerInfo) p /= Goalie ]
        nearest = minimumBy (\pl1 pl2 -> closerToPoint pos (projectP $ vsPos pl1) (projectP $ vsPos pl2)) players
    in vsObjId nearest

nearestPlayer team vss pos =
    let players = [p | p@(VSPlayer {}) <- vss, vsTeam p == team]
        nearest = minimumBy (\pl1 pl2 -> closerToPoint pos (projectP $ vsPos pl1) (projectP $ vsPos pl2)) players
    in vsObjId nearest

closerToPoint p p1 p2 =
    if distance p p1 < distance p p2 then LT else GT

fetchVS :: [VisibleState] -> ObjId -> VisibleState
fetchVS vss = fromJust . flip getObjVS vss

getObjVS :: ObjId -> [VisibleState] -> Maybe VisibleState
getObjVS oid [] = Nothing
getObjVS oid (vs:vss) =
    if vsObjId vs == oid then Just vs else getObjVS oid vss

fetchGameVS :: [VisibleState] -> VisibleState
fetchGameVS [] = error "Helper/fetchGameVS: No game in Visible States"
fetchGameVS (v:vs) =
    case v of
        VSGame {} -> v
        _ -> fetchGameVS vs

fetchBallVS :: [VisibleState] -> VisibleState
fetchBallVS [] = error "Helper/fetchBallVS: No ball in Visible States"
fetchBallVS (v:vs) =
    case v of
        VSBall {} -> v
        _ -> fetchBallVS vs

fetchBallCarrier vss =
    let (s, sp) = vsBallState ball
        ball = fetchBallVS vss
    in if s `elem` [BSControlled, BSControlledOOP, BSControlledGoalie]
           then Just (fetchVS vss (fromBPWho sp))
           else Nothing

ballId :: ALOut -> ObjId
ballId (AL []) = error "Helper.hs/ballId: No Ball in Object Output"
ballId (AL ((xId, xOO):xs)) =
   case xOO of
       ObjOutput (OOSBall {}) _ _ _ -> xId
       _ -> ballId (AL xs)

gameId :: ALOut -> ObjId
gameId (AL []) = error "Helper.hs/gameId: No Game in Object Output"
gameId (AL ((xId, xOO):xs)) =
   case xOO of
       ObjOutput (OOSGame {}) _ _ _ -> xId
       _ -> gameId (AL xs)
                                                     --  time  possession score1 score2
hasBall :: VisibleState -> Bool
hasBall vs = isPlayer vs && (fst . vsPBState) vs == PBSInPossession

offsiteFrontier param me vss =
-- yield the a position for the player on the offsite frontiert. needs at least 2 players in every team
    let myself = fetchVS vss me
        myTeam = vsTeam myself
        Point3 myXPos _ _ = vsPos myself
        others = teamPlayers (otherTeam myTeam) vss
        reverser = if myTeam == Home then id else reverse
                         -- Achtung: Auf-/absteigend sortieren je nach Home / Away!
        Point3 _ y _ = vsPos . head . tail . reverser $ sortWith (point3Y . vsPos) others
        half = pPitchLength param / 2
        yAdjust = if myTeam == Home then min y half else max y half
    in (Point2 myXPos yAdjust)
--    in (Point2 0 0)

adjustForOffsite param p@(Point2 x y) me vss =
    let pOff@(Point2 xOff yOff) = offsiteFrontier param me vss
        myself = fetchVS vss me
        myTeam = vsTeam myself
        ballCarrier = hasBall myself
    in
        if not ballCarrier &&
             (((myTeam == Home && y < yOff) ||
               (myTeam == Away && y > yOff)))
        then pOff else p

basePosition :: Param -> ObjId -> [VisibleState] -> Team -> TacticalStateParam
basePosition param me vss attacker =
-- yield me's optimal position in relation to the ball and his state (attacking or defending)
    let pi = vsPlayerInfo $ fetchVS vss me
        defensivePos = piBasePosDefense pi
        offensivePos = piBasePosOffense pi
        myTeam = vsTeam $ fetchVS vss me
        ball = fetchBallVS vss
        posBall = projectP . vsPos $ ball
        adjust = posBall .-. pitchCenter param
        adjust' = vector2 (pHorizontalShiftRatio param * vector2X adjust) (pVerticalShiftRatio param * vector2Y adjust)
--        defPos = limitPosition (border, pitchWidth + border, border + lineEnds, pitchLength + border - lineEnds) (defensivePos .+^ adjust')
        defPos = limitPosition (0, pPitchWidth param, pLineEnds param, pPitchLength param - pLineEnds param) (defensivePos .+^ adjust')
        offPos = adjustForOffsite param offensivePos me vss
    in TacticalStateParam (Just $ if myTeam == attacker then offPos else defPos)
                          Nothing
                          False
                          Nothing
                          Nothing
                          Nothing
                          Nothing

-- *************************************************************************
--
-- Various geometric functions
--
-- *************************************************************************

limitPosition (xmin, xmax, ymin, ymax) (Point2 px py) =
    Point2 (minmax xmin xmax px) (minmax ymin ymax py)
    where minmax min max z = if z < min then min else if z > max then max else z

noPoint = Point2 (-1) (-1)
zeroVel = vector3 0 0 0

sameDirection :: Param -> Velocity2 -> Velocity2 -> Bool
sameDirection param u v =
   abs(vector2Rho u) > pEps param &&
   abs((vector2Rho u + vector2Rho v) - vector2Rho (u ^+^ v)) < pEps param

inOneSecond pos vel = pos .+^ vel

(.+!) :: (Point2 Double) -> Double -> (Point3 Double)
(Point2 x y) .+! z = (Point3 x y z)


(^+!) :: (Vector2 Double) -> Double -> (Vector3 Double)
v ^+! z =
  let x = vector2X v
      y = vector2Y v
  in vector3 x y z

project :: Velocity3 -> Velocity2
project v = vector2 x y
  where x = vector3X v
        y = vector3Y v

projectP :: Position3 -> Position2
projectP v = Point2 x y
  where x = point3X v
        y = point3Y v

brake :: Param -> Velocity3 -> Double -> Velocity3
brake param v a  =
  vector3 (-b*x) (-b*y) (pGravity param)
  where x = vector3X v
        y = vector3Y v
        b = a / vector2Rho (vector2 x y)

halfPi = pi / 2

(Point2 x y) ^-. v = Point2 (vector2X v - x) (vector2Y v - y)

normTheta x
    | x < (- pi) = x + 2 * pi
    | x > pi = x - 2 * pi
    | otherwise = x

lookTo p0 p1 =
    p0 .+^ (0.0001 *^ normalize (p1 .-. p0))

towards :: Spot -> Spot -> Vector3 Double
towards curr dest =
    let delta = 20 *^ normalize (spotToPoint dest .-. spotToPoint curr)
    in delta ^+! 0

turnBy :: Vector2 Double -> Vector2 Double -> Vector2 Double
u `turnBy` v =
    fromPolar (vector2Theta u - vector2Theta v) (vector2Rho u)

isLeftFrom :: Vector2 Double -> Vector2 Double -> Bool
u `isLeftFrom` v =
    normTheta (vector2Theta (u `turnBy` v)) >= 0

u `isRigthFrom` v = v `isLeftFrom` u

sameDirAs :: Vector2 Double -> Vector2 Double -> Bool
u `sameDirAs` v =
    let theta = normTheta $ vector2Theta (u `turnBy` v)
    in
        (theta > 0 && theta < pi/2) || (theta < 0 && theta > -(pi/2))

toPolar x y =
   (atan2 y x, sqrt ((x*x) + (y*y)))

getAngle v = atan2 (vector2Y v) (vector2X v)

fromPolar theta rho =
    vector2 (rho * cos theta) (rho * sin theta)

fromPolar3 theta rho z =
    vector3 (rho * cos theta) (rho * sin theta) z

limit max v =
    let len = norm v
    in
      if len > max then (max/len) *^ v else v

mirrorPoint (Point2 x y) (Point2 ax ay) =
    Point2 (mirrorAt x ax) (mirrorAt y ay)

mirrorAt x axis = 2 * axis - x

sqr x = x * x
-- *************************************************************************
--
-- Parameters
--
-- *************************************************************************

awayGoalCenter param = Point2 (pPitchWidth param / 2) 0
homeGoalCenter param = Point2 (pPitchWidth param / 2) (pPitchLength param)
pitchCenter param = Point2 (pPitchWidth param / 2) (pPitchLength param / 2)

-- *************************************************************************
--
-- Messages and commands
--
-- *************************************************************************

comToMsg (CmdKickHigh dt) = [pm (PPTLoseMe, BSPRelease dt RTHigh)]
comToMsg (CmdKickLow dt) = [pm (PPTLoseMe, BSPRelease dt RTLow)]
comToMsg (CmdPassHigh dt) = [pm (PPTLoseMe, BSPPass dt RTHigh Nothing)]
comToMsg (CmdPassLow dt) = [pm (PPTLoseMe, BSPPass dt RTLow Nothing)]
comToMsg CmdFlipHigh = [pm (PPTLoseMe, BSPPass 1 RTHigh Nothing)]
comToMsg CmdFlipLow = [pm (PPTLoseMe, BSPPass 1 RTLow Nothing)]
--comToMsg pos CmdMoveForward = [tm (TPTMoveTo, TacticalStateParam (Just $ pos .+^ vector2 0 (-20))
--                                                                       Nothing False Nothing
--                                                                       Nothing Nothing)]
comToMsg _ = []

-- *************************************************************************
--
-- Various generic list and tupel functions
--
-- *************************************************************************

collect :: (Eq a) => [(a,b)] -> [(a, [b])]
collect [] = []
collect ((a, b) : rest) =
   (a, b:fetch a rest) : collect (remove a rest)

fetch :: (Eq a) => a -> [(a,b)] -> [b]
fetch a = map snd . filter (\(a',b) -> a == a')

remove a = filter (\(a',b) -> a /= a')

mergeList :: (Eq a) => [(a, [b])] -> [(a, [b])]
mergeList =
   map (\(a,bs) -> (a, concat bs)) . collect

fst3  (a, b, c) = a
snd3  (a, b, c) = b
thrd3 (a, b, c) = c

fromRight (Right x) = x