Rasenschach-0.1: AI.hs

module AI

where

import Language.Haskell.TH

import Debug.Trace

import FRP.Yampa (SF, Event)
import FRP.Yampa.Geometry
import FRP.Yampa.Forceable
import qualified Data.Map as M
import Data.Maybe
import Data.List
import Control.Monad
import Control.Arrow

import Global
import BasicTypes
import Physics
import States
import Message
import Helper
import Object
import Grid


-- *************************************************************************
--
-- Semantic Net for Game and Player Facts
--
-- ************************************************************************


deriveFacts :: Param -> Time -> Team -> Team -> [VisibleState] -> Facts
deriveFacts param t attacker teamAtMove vss =
    Facts
        (\_ -> Just FPEmpty)
        (\_ -> Just FPEmpty)
        (\_ -> Just FPEmpty)
        (\_ -> setBestFreePlayer)
        setNearestAIPlayer
        (\_ -> setBallIsFree)
        (\_ -> Just $ FPTeam attacker)
        (\_ -> setThrowingIn)
        (\_ -> Just $ FPFromTo currSpot setBestPosition)
        (\_ -> setKickOff)
        (\_ -> (FPPlayerId . vsObjId) `fmap`ballCarrier)
        setPlayerSpot
        setSpotValue
        (\_ -> setBestShootingVector)
        (\_ -> setBestPassingVector)
        (\_ -> setPunt)
        (\_ -> setIdling)
        (\_ -> Just $ FPTeam teamAtMove)
        (\[x, y] -> if x == y then Just FPEmpty else Nothing)
        setGT
        setGetVector

    where
        setPlayerSpot [FPPlayerId oid] =
           return $ FPSpot (pointToSpot $ projectP $ vsPos $ fetchVS vss oid)

        setSpotValue [FPSpot spot] =
           return $ FPScalar $ if attacker == Home then homeValue param spot
                               else awayValue param spot

        setGT [FPScalar x, FPScalar y] = if x > y then Just FPEmpty else Nothing

        setGetVector [FPSpot x, FPSpot y] = Just $ FPVector $ towards x y

        setNearestAIPlayer [FPTeam team, FPSpot spot] =
            Just $ FPPlayerId $ nearestAIPlayer team vss (spotToPoint spot)

        setBallIsFree =
            if fst (vsBallState ball) == BSFree then
                Just $ FPSpot $ pointToSpot (inOneSecond (projectP $ vsPos ball) (project $ vsVel ball))
            else Nothing

        ball = fetchBallVS vss
        (Point3 ballX ballY ballZ) = vsPos ball

        game = fetchGameVS vss

        currSpot = (pointToSpot . projectP . vsPos) ball

        ballCarrier = fetchBallCarrier vss

        (attackingTeam, defendingTeam) =
            (teamPlayers attacker vss, teamPlayers (otherTeam attacker) vss)

        setBestFreePlayer =
            do
               bc <- ballCarrier
               fp <- bestFreePlayer param vss bc
               return $ FPPlayerId (vsObjId fp)

        timeOfThrowIn = case vsGameState game of
                            (GSBaseOut, GPTeamPosition _ _ t _) -> Just t
                            (GSSideOut, GPTeamPosition _ _ t _) -> Just t
                            _ -> Nothing

        timeOfPossession = case vsBallState ball of
                             (_, BPWho _ t) -> Just t
                             _ -> Nothing

        setThrowingIn =  listToMaybe $
                         map (FPPlayerId . vsObjId)
                            [p | p@(VSPlayer {vsPBState = (bs, bsp)})
                                  <- vss, bs == PBSPrepareThrowIn,
                                     isJust timeOfThrowIn,
                                     t - fromJust timeOfThrowIn > 2]

        goalie = fetchGoalie attacker vss

        setPunt =
            let to = if attacker == Away then 20 else -20
            in listToMaybe $
               [FPPlayerVector (vsObjId goalie) (vector3 0 to 10)
                           | hasBall goalie && t - fromJust timeOfPossession > 2]

        setBestPosition = bestSpot vss attacker currSpot (pGrid param)

        setKickOff = if GSKickOff == (fst . vsGameState . fetchGameVS) vss && t-t0 > 1
                     then Just FPEmpty else Nothing
                     where GPTeamPosition _ _ t0 _ = (snd . vsGameState . fetchGameVS) vss

--        setBallCarrier = do
--            bc <- ballCarrier
--            return $ FPPlayer (vsObjId bc)
--                               (getPlayerValue param attacker bc)
--                               (pointToSpot $ projectP $ vsPos bc)

        setBestShootingVector =
            if ballX > 20 && ballX < 60 &&
               (attacker == Home &&
                ballY < 30
                  ||
                attacker == Away &&
                ballY > 65) then Just (FPVector v)
                            else Nothing

                               where v = towards (Spot ballX ballY) goal
                                     goal = pointToSpot (if attacker == Home then
                                                            awayGoalCenter param
                                                         else
                                                            homeGoalCenter param)

        setBestPassingVector = do
           runPathBlocked param attacker ballCarrier defendingTeam
           return $ FPVector $ towards currSpot setBestPosition

        setIdling = Just $ FPPlayers $ map vsObjId $ filter ((==) TSWaiting . fst . vsPTState) $
                        teamPlayers attacker vss



getPlayerValue param attacker pl =
    if attacker == Home then homeValue param spot
                        else awayValue param spot
    where spot = (pointToSpot . projectP . vsPos) pl

runPathBlocked param attacker ballCarrier defenders = do
    carrierVss <- ballCarrier
    let pos = projectP $ vsPos carrierVss
    let goalPos = if attacker == Home then awayGoalCenter param else homeGoalCenter param
    listToMaybe $ filter (ahead pos goalPos) defenders
    where
        ahead pos goalPos defender =
            let defenderPos = projectP $ vsPos defender
                dist = distance pos defenderPos
                Point2 dx dy = defenderPos
                Point2 x y = pos
            in
                dist < 3 &&
                if attacker == Home then dx < x
                else dx > x