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