1952 lines
112 KiB
Haskell
1952 lines
112 KiB
Haskell
module Dodge.AIs where
|
|
-- imports {{{
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Path
|
|
import Dodge.SoundLogic
|
|
import Dodge.CreatureAction
|
|
import Dodge.KeyEvents
|
|
import Dodge.RandomHelp
|
|
import Dodge.WorldEvent
|
|
import Dodge.CreatureState
|
|
|
|
import Geometry
|
|
import Picture
|
|
|
|
import Data.List
|
|
import Data.Char
|
|
import Data.Maybe
|
|
import Data.Function
|
|
import Data.Graph.Inductive.Graph
|
|
import Data.Graph.Inductive.PatriciaTree
|
|
import Data.Graph.Inductive.Query.SP
|
|
import Codec.BMP
|
|
import qualified Data.ByteString as B
|
|
import Control.Lens
|
|
import Control.Applicative
|
|
import Control.Monad.State
|
|
import Control.Monad
|
|
--import Control.Monad.Either
|
|
--import Control.Functor.Zip
|
|
import qualified SDL as SDL
|
|
|
|
import System.Random
|
|
import qualified Data.Set as S
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map as M
|
|
|
|
import Foreign.ForeignPtr
|
|
import Control.Concurrent
|
|
---}
|
|
|
|
factionIs :: Faction -> Creature -> Bool
|
|
factionIs f c = (_faction $ _crState $ c) == f
|
|
|
|
lineOrth :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
|
|
lineOrth ypos crs cpos = p
|
|
where ps = map _crPos $ IM.elems crs
|
|
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
|
|
p | dist cen ypos < 20 = ypos
|
|
| otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos
|
|
|
|
lineUp :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
|
|
lineUp ypos crs cpos = p
|
|
where ps = map _crPos $ IM.elems crs
|
|
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
|
|
p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
|
|
|
|
holdForm :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
|
|
holdForm ypos crs cpos = p
|
|
where ps = map _crPos $ IM.elems crs
|
|
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
|
|
p | dist cen ypos < 20 = ypos
|
|
| otherwise = ypos +.+ cpos -.- cen
|
|
|
|
-- not nice, a kind of encircle
|
|
spreadOut :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
|
|
spreadOut ypos crs cpos = p
|
|
where ps = map _crPos $ IM.elems crs
|
|
cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
|
|
p | dist cen ypos < 30 = ypos
|
|
| otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)
|
|
spreadFactor | dist ypos cpos > 200 = 1
|
|
| otherwise = 5
|
|
----
|
|
---- -- generalised swarm ai, works out where you go from the position of your flock
|
|
---- swarmAI :: (Point -> IM.IntMap Creature -> Point -> Point) -> Int -> World -> World
|
|
---- swarmAI f cid w =
|
|
---- let cr = _creatures w IM.! cid
|
|
---- cpos = _crPos cr
|
|
---- damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound
|
|
---- ypos = _crPos $ you w
|
|
---- flockers = IM.filter (flip (canSeePoint cid) w . _crPos)
|
|
---- $ IM.filter (factionIs $ _faction $ _crState cr)
|
|
---- $ _creatures w
|
|
---- tp = f ypos flockers cpos
|
|
---- combinedRad = _crRad cr + _crRad (you w)
|
|
---- replaceGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
---- (\gs -> newGoals ++ tail gs)
|
|
---- addGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
---- (\gs -> newGoals ++ gs)
|
|
---- replaceAction newActions = over (creatures . ix cid . crState . goals)
|
|
---- (\((_:as):ass) -> (newActions ++ as):ass)
|
|
---- addAction newActions = over (creatures . ix cid . crState . goals)
|
|
---- (\(as:ass) -> (newActions++as):ass)
|
|
---- in if _crHP cr <= 0 then killCr cid w else
|
|
---- case head $ _goals $ _crState cr of
|
|
---- [] | canSee cid (_yourID w) w
|
|
---- -> replaceGoal [[MoveToFor tp 10]] w
|
|
---- | otherwise -> w
|
|
---- (MoveToFor p x:_)
|
|
---- | dist ypos cpos < combinedRad + 5
|
|
---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- THIS WON'T WORK
|
|
---- -- think about when crdir is 0.1 and yposdir is (2pi - epsilon)
|
|
----
|
|
---- && x == 0
|
|
---- -> over (creatures . ix cid . crPos)
|
|
---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos)))
|
|
---- $ replaceAction [MeleeAttack 5]
|
|
---- $ damageYou
|
|
---- w
|
|
---- | canSee cid (_yourID w) w && dist cpos ypos < 50
|
|
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 ypos cid
|
|
---- $ replaceAction [MoveToFor ypos (max 0 (x-1))] w
|
|
---- | x == 0 && canSee cid (_yourID w) w
|
|
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid
|
|
---- $ replaceAction [MoveToFor tp 0] w
|
|
---- | x == 0 -> replaceAction [MoveToFor p 10] w
|
|
---- | canSee cid (_yourID w) w
|
|
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid
|
|
---- $ replaceAction [MoveToFor p (x-1)] w
|
|
---- | dist cpos p < 20 -> w
|
|
---- | otherwise -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid w
|
|
---- (MeleeAttack x:_)
|
|
---- | x == 0 -> replaceAction [WaitFor 5] w
|
|
---- | otherwise -> replaceAction [MeleeAttack (x-1)] w
|
|
---- (WaitFor x:gls)| x == 0 -> replaceAction [] w
|
|
---- | canSee cid (_yourID w) w
|
|
---- -> turnTowardSpeed 0.05 ypos cid
|
|
---- $ replaceAction [WaitFor (x-1)] w
|
|
---- | otherwise -> replaceAction [WaitFor (x-1)] w
|
|
----
|
|
---- encircleAI' :: Int -> World -> World
|
|
---- encircleAI' cid w =
|
|
---- let cr = _creatures w IM.! cid
|
|
---- cpos = _crPos cr
|
|
---- damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound
|
|
---- ypos = _crPos $ you w
|
|
---- flockers = IM.filter (flip (canSeePoint cid) w . _crPos)
|
|
---- $ IM.filter (factionIs $ EncircleFlock)
|
|
---- $ _creatures w
|
|
---- tp | length flockers <= 1 = ypos
|
|
---- | otherwise = ypos +.+
|
|
---- f (max 0 (magV (ypos -.- cenp) - 30) )
|
|
---- *.* safeNormalizeV (cpos -.- cenp)
|
|
---- where f x = 150 * sigmoid (x-10)
|
|
---- cenp = (1 / fromIntegral (length flockers)) *.*
|
|
---- foldr1 (+.+)
|
|
---- (map _crPos $ IM.elems flockers)
|
|
---- combinedRad = _crRad cr + _crRad (you w)
|
|
---- replaceGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
---- (\gs -> newGoals ++ tail gs)
|
|
---- addGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
---- (\gs -> newGoals ++ gs)
|
|
---- replaceAction newActions = over (creatures . ix cid . crState . goals)
|
|
---- (\((_:as):ass) -> (newActions ++ as):ass)
|
|
---- addAction newActions = over (creatures . ix cid . crState . goals)
|
|
---- (\(as:ass) -> (newActions++as):ass)
|
|
---- in if _crHP cr <= 0 then killCr cid w else
|
|
---- case head $ _goals $ _crState cr of
|
|
---- [] | canSee cid (_yourID w) w
|
|
---- -> replaceGoal [[MoveToFor tp 10]] w
|
|
---- | otherwise -> w
|
|
---- (MoveToFor p x:_)
|
|
---- | dist ypos cpos < combinedRad + 5
|
|
---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above
|
|
---- && x == 0
|
|
---- -> over (creatures . ix cid . crPos)
|
|
---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos)))
|
|
---- $ replaceAction [MeleeAttack 5]
|
|
---- $ damageYou
|
|
---- w
|
|
---- | canSee cid (_yourID w) w && dist cpos ypos < 50
|
|
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 ypos cid
|
|
---- $ replaceAction [MoveToFor ypos (max 0 (x-1))] w
|
|
---- | x == 0 && canSee cid (_yourID w) w
|
|
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid
|
|
---- $ replaceAction [MoveToFor tp 0] w
|
|
---- | x == 0 -> replaceAction [MoveToFor p 10] w
|
|
---- | canSee cid (_yourID w) w
|
|
---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid
|
|
---- $ replaceAction [MoveToFor p (x-1)] w
|
|
---- | dist cpos p < 20 -> w
|
|
---- | otherwise -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid w
|
|
---- (MeleeAttack x:_)
|
|
---- | x == 0 -> replaceAction [WaitFor 5] w
|
|
---- | otherwise -> replaceAction [MeleeAttack (x-1)] w
|
|
---- (WaitFor x:gls)| x == 0 -> replaceAction [] w
|
|
---- | canSee cid (_yourID w) w
|
|
---- -> turnTowardSpeed 0.02 ypos cid
|
|
---- $ replaceAction [WaitFor (x-1)] w
|
|
---- | otherwise -> replaceAction [WaitFor (x-1)] w
|
|
|
|
spawnerAI :: Creature -> World -> (World -> World,StdGen) -> Creature
|
|
-> ((World -> World, StdGen), Maybe Creature)
|
|
spawnerAI spawn w (f,g) cr =
|
|
let dir = _crDir cr
|
|
cid = _crID cr
|
|
cpos = _crPos cr
|
|
ypos = _crPos $ you w
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
|
|
needChild = length (filter (\cr' -> (cr' ^? crState . faction) == Just (SpawnedBy cid))
|
|
$ IM.elems $ _creatures w)
|
|
< 15
|
|
spawnChild = placeCrFaction spawn (SpawnedBy cid) (cpos +.+ rotateV dir (1,0)) cpos (_crDir cr)
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
(WaitFor x:_) | x == 0 && needChild
|
|
-> ( (spawnChild . f , g)
|
|
,replaceAction [WaitFor 200] $ over crDir (+ 1) cr
|
|
)
|
|
| canSee cid (_yourID w) w
|
|
-> ( (f , g)
|
|
,replaceAction [WaitFor (max 0 (x-1))]
|
|
$ set (crDir) (argV (ypos -.- cpos)) cr )
|
|
| otherwise -> ( (f , g)
|
|
,replaceAction [WaitFor (max 0 (x-1))] cr)
|
|
|
|
placeCrFaction :: Creature -> Faction -> Point2 -> Point2 -> Float -> World -> World
|
|
placeCrFaction cr fact p op rot w = over creatures addCr w
|
|
where addCr crs = IM.insert (newKey crs)
|
|
( set (crState . faction) fact
|
|
$ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = newKey crs}
|
|
)
|
|
crs
|
|
|
|
|
|
chaseAI ::
|
|
World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
|
|
chaseAI w (f,g') cr =
|
|
let cid = _crID cr
|
|
cpos = _crPos cr
|
|
damageYou = over (creatures . ix 0 . crState . crDamage) addDam
|
|
. soundOnce (fromIntegral hitSound)
|
|
addDam dams = (( Blunt 100 cpos cpos cpos ) : dams )
|
|
ypos = _crPos $ you w
|
|
combinedRad = _crRad cr + _crRad (you w)
|
|
(a,g) = randomR (-0.2,0.2) g'
|
|
(wtime,g1) = randomR (15,25) g'
|
|
randomTurn = over crDir (+a)
|
|
randomTurn2 = over crDir (+(signum a))
|
|
isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2
|
|
isCloseFaction cr' = _faction (_crState cr') == _faction (_crState cr)
|
|
&& dist cpos (_crPos cr') < 25
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] -> ((f, g') , replaceGoal [] cr)
|
|
(Wait:_) | dist cpos ypos < 900 && hasLOS cpos ypos w
|
|
-> ((f ,g')
|
|
,addGoal [[WaitFor wtime,MoveTo ypos]] cr)
|
|
| dist cpos ypos < 900 && hasLOSIndirect cpos ypos w
|
|
-> ((f , g')
|
|
,addGoal [[WaitFor wtime,PathTo ypos]] cr)
|
|
| otherwise -> ( (f , g')
|
|
,Just cr)
|
|
(WaitFor x:gls)| x == 0 -> ( (f , g')
|
|
,replaceAction [] cr
|
|
-- $ drawCircleAtForCol cpos 10 (withAlpha 0.5 cyan)
|
|
)
|
|
| hasLOS cpos ypos w
|
|
-> ( (f, g')
|
|
,replaceAction [WaitFor (x-1)] $ crTurnTowardSpeed 0.05 ypos cr
|
|
)
|
|
| otherwise -> ( (f, g')
|
|
, replaceAction [WaitFor (x-1)] cr )
|
|
(MoveTo p:gls)
|
|
| dist ypos cpos < combinedRad + 5
|
|
&& abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above
|
|
-> ( (damageYou . f , g')
|
|
, replaceAction [MeleeAttack 5] $
|
|
over crPos
|
|
(+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) cr
|
|
)
|
|
| hasLOS cpos ypos w -> ( (f , g)
|
|
, replaceAction [MoveTo ypos]
|
|
$ crMvForward 2.5 $ randomTurn
|
|
$ crTurnTowardSpeed 0.05 p cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f, g')
|
|
, replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f ,g' )
|
|
, Just $ crTurnTowardSpeed 0.05 p cr)
|
|
| otherwise -> ( (f, g' )
|
|
, Just $ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
|
|
(MoveToFor p x:gls)
|
|
| hasLOS cpos ypos w ->
|
|
( (f , g )
|
|
, replaceAction [MoveTo ypos]
|
|
$ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g)
|
|
, replaceAction [] cr)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (max 0 (x-1))]
|
|
$ crTurnTowardSpeed 0.05 p cr)
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (max 0 (x-1))]
|
|
$ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
|
|
(PathTo p:_)
|
|
| dist p cpos < 10 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
-- $ drawCircleAtForCol p 10 (withAlpha 0.5 blue)
|
|
)
|
|
| hasLOS cpos p w -> ( (f , g)
|
|
, addAction [MoveToFor p 10] cr
|
|
-- $ drawCircleAtForCol p 10 (withAlpha 0.5 green)
|
|
)
|
|
| otherwise ->
|
|
--((f, g) , replaceAction [] cr)
|
|
-- case makePathBetweenPs cpos p w of
|
|
-- Just (q:_) -> ( (f , g)
|
|
--
|
|
-- , addAction [MoveToFor q 10] cr
|
|
-- )
|
|
-- _ -> ((f , g)
|
|
--
|
|
-- , replaceAction [] cr
|
|
-- )
|
|
case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g)
|
|
|
|
, addAction [MoveToFor q 10] cr
|
|
)
|
|
_ -> ((f , g)
|
|
|
|
, replaceAction [] cr
|
|
)
|
|
|
|
-- case pointTowardsGoal' cpos p w of
|
|
-- Right q -> addAction [MoveToFor q 10]
|
|
----- let ns = map fst $ concatMap doublePair $ _pathGraph' w
|
|
----- a' = listToMaybe $ sortBy (compare `on` dist cpos) $ ns
|
|
----- b' = listToMaybe $ sortBy (compare `on` dist p) $ ns
|
|
----- g :: World -> World
|
|
----- g = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 yellow) a'
|
|
----- h = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 blue) b'
|
|
----- incf = incidenceToFunction $ pairsToIncidence
|
|
----- $ concatMap doublePair $ _pathGraph' w
|
|
----- as :: [Point]
|
|
----- as = concat $ maybeToList $ fmap incf a'
|
|
----- g' w = foldr (\p -> drawCircleAtForCol p 5 orange) w as
|
|
----- h' qs w = foldr (\p -> drawCircleAtForCol p 5 orange) w qs
|
|
----- in case makePath' <$> return incf <*> b' <*> a' of
|
|
----- Just (q:qs) -> ( f . h' qs
|
|
----- . drawCircleAtForCol q 10 magenta
|
|
----- , addAction [MoveToFor q 10] cr
|
|
----- -- $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs
|
|
----- -- cpos p w)) ++ [p]) 50 red
|
|
----- )
|
|
------- Left s -> error s
|
|
------- - -> (f,cr)
|
|
----- _ -> ( f
|
|
----- . g . h . g'
|
|
----- , replaceAction [] cr
|
|
----- )
|
|
(MeleeAttack x:_)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [WaitFor wtime] cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MeleeAttack (x-1)] cr )
|
|
|
|
---- meleeAI' :: Int -> World -> World
|
|
---- meleeAI' cid w = let cr = _creatures w IM.! cid
|
|
---- cpos = _crPos cr
|
|
---- damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound
|
|
---- ypos = _crPos $ you w
|
|
---- combinedRad = _crRad cr + _crRad (you w)
|
|
---- (a,g) = randomR (-0.2,0.2) $ _randGen w
|
|
---- (wtime,g1) = randomR (15,25) $ _randGen w
|
|
---- randomTurn = set randGen g . over (creatures . ix cid . crDir) (+a)
|
|
---- randomTurn2 = set randGen g . over (creatures . ix cid . crDir) (+(signum a))
|
|
---- isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2
|
|
---- isCloseFaction cr' = _faction (_crState cr') == ChaseCritters
|
|
---- && dist cpos (_crPos cr') < 25
|
|
---- replaceGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
---- (\gs -> newGoals ++ tail gs)
|
|
---- addGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
---- (\gs -> newGoals ++ gs)
|
|
---- replaceAction newActions = over (creatures . ix cid . crState . goals)
|
|
---- (\((_:as):ass) -> (newActions ++ as):ass)
|
|
---- addAction newActions = over (creatures . ix cid . crState . goals)
|
|
---- (\(as:ass) -> (newActions++as):ass)
|
|
---- in if _crHP cr <= 0 then killCr cid w else
|
|
---- case head $ _goals $ _crState cr of
|
|
---- [] | canSee cid (_yourID w) w
|
|
---- -> replaceGoal [[MoveToFor ypos 10]] w
|
|
---- | canSeeIndirect cid (_yourID w) w
|
|
---- -> addGoal [[PathTo ypos]] w
|
|
---- | otherwise -> replaceGoal [] w
|
|
---- (WaitFor x:gls)| x == 0 -> replaceAction [] w
|
|
---- | canSee cid (_yourID w) w
|
|
---- -> turnTowardSpeed 0.05 ypos cid
|
|
---- $ replaceAction [WaitFor (x-1)] w
|
|
---- | otherwise -> replaceAction [WaitFor (x-1)] w
|
|
---- (MoveToFor p x:gls)
|
|
---- | dist ypos cpos < combinedRad + 5
|
|
---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above
|
|
---- -- && x == 0
|
|
---- -> over (creatures . ix cid . crPos)
|
|
---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos)))
|
|
---- $ replaceAction [MeleeAttack 5]
|
|
---- $ damageYou
|
|
---- w
|
|
---- | x == 0 && isCrowded -> replaceAction [] $ randomTurn2 w
|
|
---- | canSee cid (_yourID w) w -> replaceGoal [[MoveToFor ypos (max 0 (x-1))]]
|
|
---- $ mvForward 2.5 cid $ randomTurn $ turnTowardSpeed 0.05 p cid w
|
|
---- | dist p cpos < 10 -> replaceAction [] w
|
|
---- | x == 0 -> replaceAction [] w
|
|
---- -- | not (canSeePoint cid p w) -> replaceAction [PathTo p] w
|
|
---- -- | not (canSeePoint cid p w) -> replaceAction [] w
|
|
---- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
---- -> replaceAction [MoveToFor p (max 0 (x-1))] $ turnTowardSpeed 0.05 p cid w
|
|
---- | otherwise -> replaceAction [MoveToFor p (max 0 (x-1))]
|
|
---- $ mvForward 2.5 cid $ turnTowardSpeed 0.05 p cid w
|
|
---- (PathTo p:_)
|
|
---- | dist p cpos < 10 -> replaceAction [] w
|
|
---- | canSeePoint cid p w -> addAction [MoveToFor p 10] w
|
|
---- | otherwise ->
|
|
---- case pointTowardsGoal' cpos p w of
|
|
---- Right q -> addAction [MoveToFor q 10]
|
|
---- -- $ drawCircleAtForCol q 10 magenta
|
|
---- -- $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs
|
|
---- -- cpos p w)) ++ [p]) 50 red
|
|
---- w
|
|
---- --Left s -> error s
|
|
---- _ -> replaceAction [] w
|
|
---- (MeleeAttack x:_)
|
|
---- | x == 0 -> replaceAction [WaitFor wtime] w
|
|
---- | otherwise -> replaceAction [MeleeAttack (x-1)] w
|
|
---- (TrackYou:_) -> addGoal [[WaitFor wtime,PathTo ypos]] $ set randGen g1 w
|
|
---- (InitTrackYou:_)| canSeeIndirect cid (_yourID w) w -> replaceGoal [[TrackYou]] w
|
|
---- | otherwise -> w
|
|
---- (Guard p p':_) | canSeeIndirect cid (_yourID w) w
|
|
---- -> addGoal [[WaitFor wtime,PathTo ypos]] $ set randGen g1 w
|
|
---- | dist cpos p > 10
|
|
---- -> addGoal [[PathTo p]] w
|
|
---- | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
---- -> turnTowardSpeed 0.05 p' cid w
|
|
---- | otherwise -> w
|
|
---- (InitGuard :_) -> replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] w
|
|
|
|
-- be aware that the crit can be removed -- don't just refer to its id in the
|
|
-- world->world part
|
|
miniAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
miniAI w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
(aimtime,g1) = randomR (80,120) g
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
turnCloseSlow p | errorAngleVV 22 (p -.- cpos)
|
|
(unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.01 p
|
|
| otherwise = crTurnTowardSpeed 0.05 p
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
-- autoFireTweak p | _wpIsAuto wp = Just
|
|
-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]]
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| otherwise -> ( ( f , g )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f ,g ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g1)
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g) , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g) , replaceAction [] cr )
|
|
(FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
|
|
, replaceGoal [[Reload
|
|
,PathTo p
|
|
,WaitFor 50
|
|
--,Search 1 ,WaitFor 100
|
|
]]
|
|
cr
|
|
)
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr
|
|
)
|
|
| pathToPointFireable cid p w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, Just $ turnCloseSlow p cr
|
|
)
|
|
| otherwise -> ( (f , g)
|
|
, replaceGoal [[PathTo p,WaitFor 50 ]] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g)
|
|
, Just $ turnCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
|
|
| otherwise
|
|
-> ( ( f , g1)
|
|
, replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w)
|
|
, Search (i-1)
|
|
] cr
|
|
)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g1)
|
|
, addGoal [[AimAt ypos (0)]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr )
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p cr)
|
|
| otherwise
|
|
-> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr)
|
|
|
|
strafeOrChargeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
strafeOrChargeAI inRange outRange w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
(aimtime,g1) = randomR (80,120) g
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
inR p aRange = dist p cpos < aRange
|
|
inA p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.2
|
|
inA' p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < pi/2
|
|
strafeClockwise p | dist cpos p > 200 = crTurnTowardSpeed 0.05 p . crMvForward 3
|
|
| dist cpos p < 80 = crTurnTowardSpeed 0.05 p . crMvForward (-3)
|
|
| errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.01 p' . crStrafeLeft 3
|
|
| otherwise
|
|
= crTurnTowardSpeed 0.05 p' . crStrafeLeft 3
|
|
where v = vNormal $ p -.- cpos
|
|
p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v))
|
|
strafeCloseSlow p | dist cpos p > 200 = crTurnTowardSpeed 0.05 p . crMvForward 3
|
|
| dist cpos p < 80 = crTurnTowardSpeed 0.05 p . crMvForward (-3)
|
|
| errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.01 p' . crStrafeLeft 3
|
|
| otherwise
|
|
= crTurnTowardSpeed 0.05 p' . crStrafeLeft 3
|
|
where v = vNormal $ p -.- cpos
|
|
p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v))
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
-- autoFireTweak p | _wpIsAuto wp = Just
|
|
-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]]
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| otherwise -> ( ( f , g )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]]
|
|
cr
|
|
)
|
|
| x == 0 -> ( (f ,g ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g1)
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g) , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g) , replaceAction [] cr )
|
|
(FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
|
|
, replaceGoal [[Reload
|
|
,PathTo p
|
|
,WaitFor 50
|
|
--,Search 1 ,WaitFor 100
|
|
]]
|
|
cr
|
|
)
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, replaceGoal [[FireAt ypos]] $ strafeCloseSlow p cr
|
|
)
|
|
| pathToPointFireable cid p w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, Just $ strafeCloseSlow p cr
|
|
)
|
|
| otherwise -> ( (f , g)
|
|
, replaceGoal [[PathTo p,WaitFor 50 ]] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g)
|
|
, Just $ strafeCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
|
|
| otherwise
|
|
-> ( ( f , g1)
|
|
, replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w)
|
|
, Search (i-1)
|
|
] cr
|
|
)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g1)
|
|
, addGoal [[AimAt ypos (2*aimtime)]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr )
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ strafeCloseSlow p
|
|
cr
|
|
)
|
|
| otherwise
|
|
-> ( (f,g) , replaceAction [AimAt p (i-1)] $ strafeCloseSlow p cr)
|
|
|
|
chargeAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
chargeAI w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
(aimtime,g') = randomR (80,120::Float) g
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
fTurn p | errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.005 p
|
|
| errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 1
|
|
= crTurnTowardSpeed 0.05 p
|
|
| otherwise
|
|
= crTurnTowardSpeed 0.2 p
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
updateSearch = over (crState . goals) f
|
|
where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs)
|
|
f (g:gs) = (g:[PathTo ypos]:gs)
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
(MoveTo p:_)
|
|
| dist cpos ypos < 40 -> ((f,g) , replaceAction [Fire] cr)
|
|
| canSeeFire cpos ypos w -> ((f,g), Just . crMvBy (3,0) . fTurn ypos $ cr)
|
|
| otherwise -> ((f,g), Just . crMvBy (3,0) . fTurn p $ cr)
|
|
(Fire:_)
|
|
| dist cpos ypos < 60 && canSeeFire cpos ypos w
|
|
-> ((tryUseItem cid . f,g), Just $ fTurn ypos cr)
|
|
| otherwise -> ((f,g), replaceAction [] cr)
|
|
[] | canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g' ) , addAction [MoveTo ypos] cr)
|
|
| otherwise -> ( ( f , g' ) , Just cr)
|
|
(WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g')
|
|
, replaceAction [MoveTo ypos] cr
|
|
)
|
|
| x == 0 -> ( (f , g')
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g') , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g') , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g') , replaceAction [] cr )
|
|
(Init:_) -> ((f,g), replaceAction [] cr)
|
|
|
|
launcherAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
launcherAI inRange outRange w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
yposl x = ypos -.- x *.* (vNormal $ normalizeV $ ypos -.- cpos)
|
|
yposr x = ypos +.+ x *.* (vNormal $ normalizeV $ ypos -.- cpos)
|
|
(aimtime,g') = randomR (80,120) g
|
|
(recupTime,_) = randomR (0,50) g
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
noAmmo = 0 == _wpLoadedAmmo wp || _wpReloadState wp /= 0
|
|
updateSearch = over (crState . goals) f
|
|
where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs)
|
|
f (g:gs) = (g:[PathTo ypos]:gs)
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
ts = take 3 $ randomRs (20,25) g
|
|
retreatActions = SetPosture Aiming
|
|
: Fire
|
|
: TurnByFor 0.16 20
|
|
: SetPosture AtEase
|
|
: MoveByFor (3,0) 18
|
|
: SetPosture Aiming
|
|
: Fire
|
|
: TurnByFor (-0.16) 20
|
|
: SetPosture AtEase
|
|
: MoveByFor (3,0) 10
|
|
: TurnToward ypos
|
|
-- : WaitFor 12
|
|
-- : Fire
|
|
-- : WaitFor 20
|
|
: SetPosture Aiming
|
|
: Fire
|
|
: WaitFor 60
|
|
: [SetPosture AtEase]
|
|
strafeLeftActions = TurnToward (yposr 30)
|
|
: SetPosture Aiming
|
|
: (concatMap (\t -> [Fire,MoveByFor (0,3) t]) ts)
|
|
++ [SetPosture AtEase]
|
|
strafeRightActions = TurnToward (yposl 30)
|
|
: SetPosture Aiming
|
|
: (concatMap (\t -> [Fire,MoveByFor (0,-3) t]) ts)
|
|
++ [SetPosture AtEase]
|
|
rota a = cpos +.+ rotateV a (ypos -.- cpos)
|
|
(a2:a3:a4:a5:_) = evalState (takeOne [[0.1,0.15,0.5,1.5]
|
|
--,[0.1,0.15,0.5,1.5]
|
|
-- ,[0.2,0.3,0.6,1]
|
|
-- ,[0.2,0.3,0.5,0.8]
|
|
-- ,[0.2,0.3,0.5,1]
|
|
-- ,[0.1,0.2,0.5,0.9]
|
|
-- ,[0.1,0.2,0.4,0.7]
|
|
-- ,[0.1,0.2,0.3,0.4]
|
|
]
|
|
) g
|
|
curveLeft = TurnToward (rota $ negate a2)
|
|
: SetPosture Aiming
|
|
: Fire
|
|
: TurnToward (rota $ negate a3)
|
|
: WaitFor 20
|
|
: Fire
|
|
: TurnToward (rota $ negate a4)
|
|
: WaitFor 20
|
|
: Fire
|
|
: TurnToward (rota $ negate a5)
|
|
: SetPosture AtEase
|
|
: [MoveByFor (-3,0) 40]
|
|
curveRight = TurnToward (rota a2)
|
|
: SetPosture Aiming
|
|
: Fire
|
|
: TurnToward (rota a3)
|
|
: WaitFor 20
|
|
: Fire
|
|
: TurnToward (rota a4)
|
|
: WaitFor 20
|
|
: Fire
|
|
: TurnToward (rota a5)
|
|
: SetPosture AtEase
|
|
: [MoveByFor (-3,0) 40]
|
|
strafeProb :: Float
|
|
strafeProb | dist cpos ypos > 350 = 40
|
|
| otherwise = 10
|
|
retreatProb | dist cpos ypos < 100 = 80
|
|
| dist cpos ypos < 200 = 40
|
|
| otherwise = 0
|
|
curveLeftProb = 20
|
|
curveRightProb = 20
|
|
-- | dist cpos ypos < 200 = 1
|
|
-- | otherwise = 0
|
|
fireActions = -- TurnToward ypos :
|
|
(evalState (takeOneWeighted
|
|
[curveLeftProb,curveRightProb
|
|
,strafeProb,strafeProb,retreatProb]
|
|
[curveLeft
|
|
,curveRight
|
|
,strafeLeftActions
|
|
,strafeRightActions
|
|
,retreatActions
|
|
]
|
|
) $ g
|
|
)
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
(TurnTo p:_) -> ( (f,g') , replaceAction [] . crTurnTo p $ cr)
|
|
(TurnByFor a 0:_) -> ( (f,g') , replaceAction [] . over crDir (+a) $ cr)
|
|
(TurnByFor a i:_) -> ( (f,g') , replaceAction [TurnByFor a (i-1)] . over crDir (+a) $ cr)
|
|
(SetPosture pture:_) -> ((f,g), replaceAction [] $ set (crState . stance . posture) pture cr)
|
|
(MoveByFor p 0:_) -> ((f,g'), replaceAction [] . crMvBy p $ cr)
|
|
(MoveByFor p i:_) -> ((f,g'), replaceAction [MoveByFor p (i-1)] . crMvBy p $ cr)
|
|
(Fire:_) | collidePointWallsSimple cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr))
|
|
(wallsAlongLine cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) w)
|
|
-> ((f,g),replaceAction [] cr)
|
|
| otherwise -> ((tryUseItem cid . f,g'), replaceAction [] cr)
|
|
(GoalID i (MoveByFor p 0):_) -> ((f,g'), replaceAction [] . crMvBy p $ cr)
|
|
(GoalID i (MoveByFor p x):_)
|
|
| canSeeFire cpos (aCrPos i w) w
|
|
-> ( (f,g')
|
|
, replaceAction [GoalID i (MoveByFor p (x-1))]
|
|
. crMvBy p
|
|
. crTurnTowardSpeed 0.01 (aCrPos i w)
|
|
$ cr
|
|
)
|
|
| otherwise
|
|
-> ( (f,g')
|
|
, replaceAction [GoalID i (MoveForwardFor (x-1))]
|
|
. crMvBy p
|
|
$ cr
|
|
)
|
|
(TurnToward p:_)
|
|
| errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2
|
|
-> ( (f,g')
|
|
, Just . crTurnTowardSpeed 0.5 p
|
|
$ cr
|
|
)
|
|
| errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2
|
|
-> ( (f,g')
|
|
, Just . crTurnTowardSpeed 0.1 p
|
|
$ cr
|
|
)
|
|
| otherwise
|
|
-> ( (f,g')
|
|
, replaceAction []
|
|
. crTurnTo p
|
|
$ cr
|
|
)
|
|
[] | noAmmo -> ( (tryUseItem cid . f, g')
|
|
, addAction [Reload] cr
|
|
)
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g' )
|
|
-- , addAction (WaitFor 9:fireActions)
|
|
, addAction (WaitFor 9:fireActions)
|
|
$ updateSearch cr
|
|
)
|
|
| otherwise -> ( ( f , g' )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g')
|
|
, replaceGoal [[],[PathTo ypos]] cr
|
|
)
|
|
| x == 0 -> ( (f , g')
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g') , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g') , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g') , replaceAction [] cr )
|
|
(Reload:_) | _wpReloadState wp == 0 -> ( (f , g') , replaceAction [WaitFor recupTime] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g')
|
|
, Just $ cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g') , Just cr)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g')
|
|
, addGoal [[WaitFor aimtime],[PathTo ypos]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g') , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g')
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g') ,Just cr)
|
|
(Init :_) -> ( (f,g')
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
dodgeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
dodgeAI inRange outRange w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
yposl x = ypos -.- x *.* (vNormal $ normalizeV $ ypos -.- cpos)
|
|
yposr x = ypos +.+ x *.* (vNormal $ normalizeV $ ypos -.- cpos)
|
|
(aimtime,g') = randomR (0,120) g
|
|
(recupTime,_) = randomR (0,50) g
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
updateSearch = over (crState . goals) f
|
|
where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs)
|
|
f (g:gs) = (g:[PathTo ypos]:gs)
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
retreatOffset = let a | dist cpos ypos < 50 = 0
|
|
| isLeftOfA (_crDir cr) (argV $ ypos -.- cpos)
|
|
= -0.7
|
|
| otherwise = 0.7
|
|
in fromMaybe ypos
|
|
$ intersectLineLine' cpos
|
|
(cpos +.+ rotateV a (ypos -.- cpos))
|
|
ypos
|
|
(ypos +.+ vNormal (cpos -.- ypos))
|
|
ts = take 5 $ randomRs (7,10) g
|
|
chargeActions = TurnToward ypos
|
|
: (GoalID 0 (MoveByFor (3,0) 15))
|
|
: (concatMap (\t -> [GoalID 0 (MoveByFor (3,0) t),Fire]) ts)
|
|
retreatActions = TurnToward retreatOffset
|
|
:(GoalID 0 (MoveByFor (-3,0) 9))
|
|
: (concatMap (\t -> [GoalID 0 (MoveByFor (-3,0) t),Fire]) ts)
|
|
strafeLeftActions = TurnToward (yposr 150) : MoveByFor (0,3) 4
|
|
: (concatMap (\t -> [MoveByFor (0,3) t,Fire]) ts)
|
|
strafeRightActions = TurnToward (yposl 150) : MoveByFor (0,-3) 4
|
|
: (concatMap (\t -> [MoveByFor (0,-3) t,Fire]) ts)
|
|
chargeProb :: Float
|
|
chargeProb | dist cpos ypos > 300 = 5
|
|
| dist cpos ypos > 150 = 1
|
|
| otherwise = 0
|
|
strafeProb | dist cpos ypos > 150 = 1
|
|
| otherwise = 0
|
|
retreatProb | dist cpos ypos < 200 = 1
|
|
| otherwise = 0
|
|
fireActions = -- TurnToward ypos :
|
|
(evalState (takeOneWeighted
|
|
[chargeProb,retreatProb,strafeProb,strafeProb]
|
|
[chargeActions
|
|
,retreatActions
|
|
,strafeLeftActions
|
|
,strafeRightActions
|
|
]
|
|
) $ g
|
|
)
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
(MoveByFor p 0:_) -> ((f,g'), replaceAction [] . crMvBy p $ cr)
|
|
(MoveByFor p i:_) -> ((f,g'), replaceAction [MoveByFor p (i-1)] . crMvBy p $ cr)
|
|
(Fire:_) -> ((tryUseItem cid . f,g'), replaceAction [] cr)
|
|
(GoalID i (MoveByFor p 0):_) -> ((f,g'), replaceAction [] . crMvBy p $ cr)
|
|
(GoalID i (MoveByFor p x):_)
|
|
| canSeeFire cpos (aCrPos i w) w
|
|
-> ( (f,g')
|
|
, replaceAction [GoalID i (MoveByFor p (x-1))]
|
|
. crMvBy p
|
|
. crTurnTowardSpeed 0.01 (aCrPos i w)
|
|
$ cr
|
|
)
|
|
| otherwise
|
|
-> ( (f,g')
|
|
, replaceAction [GoalID i (MoveByFor p (x-1))]
|
|
. crMvBy p $ cr
|
|
)
|
|
(TurnToward p:_)
|
|
| errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2
|
|
-> ( (f,g')
|
|
, Just . crTurnTowardSpeed 0.2 p
|
|
$ cr
|
|
)
|
|
| errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2
|
|
-> ( (f,g')
|
|
, Just . crTurnTowardSpeed 0.1 p
|
|
$ cr
|
|
)
|
|
| otherwise
|
|
-> ( (f,g')
|
|
, replaceAction []
|
|
$ cr
|
|
)
|
|
[] | noAmmo -> ( (tryUseItem cid . f, g') , addAction [Reload] cr)
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g' ) , addAction (WaitFor 9:fireActions) $ updateSearch cr)
|
|
| otherwise -> ( ( f , g' ) , replaceGoal [] cr)
|
|
(WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)]
|
|
$ crTurnTowardSpeed 0.05 ypos cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g')
|
|
, replaceGoal [[],[PathTo ypos]] cr
|
|
)
|
|
| x == 0 -> ( (f , g')
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g') , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g') , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g') , replaceAction [] cr )
|
|
(Reload:_) | _wpReloadState wp == 0 -> ( (f , g') , replaceAction [WaitFor recupTime] cr )
|
|
| otherwise -> ( (f , g') , Just cr)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g')
|
|
, addGoal [[WaitFor aimtime],[PathTo ypos]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g') , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g')
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g') ,Just cr)
|
|
(InitGuard :_) -> ( ( f,g')
|
|
-- (InitGuard :_) -> ( (over lightSources (IM.insert cid (crLight cid)) . f,g')
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(x:_) -> error $ "missing the following pattern in case expression:" ++ show x
|
|
|
|
logistic :: Float -> Float -> Float -> (Float -> Float)
|
|
logistic x0 l k x = l / (1 + exp (k*(x0 - x)))
|
|
|
|
|
|
circleClockwiseAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
circleClockwiseAI inRange outRange w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
(aimtime,g1) = randomR (80,120) g
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
inR p aRange = dist p cpos < aRange
|
|
inA p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.2
|
|
inA' p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < pi/2
|
|
strafeCloseSlow p | dist cpos p > 200 = crTurnTowardSpeed 0.05 p . crMvForward 3
|
|
| dist cpos p < 80 = crTurnTowardSpeed 0.05 p . crMvForward (-3)
|
|
| errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.01 p' . crStrafeLeft 3
|
|
| otherwise
|
|
= crTurnTowardSpeed 0.05 p' . crStrafeLeft 3
|
|
where v = vNormal $ p -.- cpos
|
|
p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v))
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
-- autoFireTweak p | _wpIsAuto wp = Just
|
|
-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]]
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| otherwise -> ( ( f , g )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]]
|
|
cr
|
|
)
|
|
| x == 0 -> ( (f ,g ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g1)
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g) , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g) , replaceAction [] cr )
|
|
(FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
|
|
, replaceGoal [[Reload
|
|
,PathTo p
|
|
,WaitFor 50
|
|
--,Search 1 ,WaitFor 100
|
|
]]
|
|
cr
|
|
)
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, replaceGoal [[FireAt ypos]] $ strafeCloseSlow p cr
|
|
)
|
|
| pathToPointFireable cid p w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, Just $ strafeCloseSlow p cr
|
|
)
|
|
| otherwise -> ( (f , g)
|
|
, replaceGoal [[PathTo p,WaitFor 50 ]] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g)
|
|
, Just $ strafeCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
|
|
| otherwise
|
|
-> ( ( f , g1)
|
|
, replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w)
|
|
, Search (i-1)
|
|
] cr
|
|
)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g1)
|
|
, addGoal [[AimAt ypos (2*aimtime)]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr )
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ strafeCloseSlow p
|
|
cr
|
|
)
|
|
| otherwise
|
|
-> ( (f,g) , replaceAction [AimAt p (i-1)] $ strafeCloseSlow p cr)
|
|
|
|
twitchMissAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
twitchMissAI inRange outRange w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
yposl = ypos +.+ 25 *.* normalizeV (vNormal (cpos -.- ypos))
|
|
yposr = ypos -.- 25 *.* normalizeV (vNormal (cpos -.- ypos))
|
|
yposoff = evalState (takeOne [yposl,yposr]) $ _randGen w
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
fireRate = fromMaybe 0 $ wp ^? wpFireRate
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
strafeCloseSlow p | errorAngleVV 22 (p -.- cpos)
|
|
(unitVectorAtAngle (_crDir cr)) < 0.1
|
|
= crTurnTowardSpeed 0.01 p . crMvForward closeDist
|
|
| otherwise
|
|
= crTurnAndStrafeIn inOrOut 0.05 p
|
|
where inOrOut | dist p cpos < inRange = -1
|
|
| dist p cpos < outRange = 0
|
|
| otherwise = 1
|
|
closeDist | dist p cpos < inRange = -1
|
|
| dist p cpos < outRange = 0
|
|
| otherwise = 1
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
(t,g') = randomR (fireRate+10,fireRate+15) g
|
|
retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400
|
|
where f p = fromMaybe (ypos +.+ p) $ fmap fst
|
|
$ collidePointWalls ypos (ypos +.+ p) (wallsAlongLine ypos (ypos +.+ p) w)
|
|
retreatP' = cpos +.+ 300 *.* (cpos -.- ypos)
|
|
retreatP'' = fromMaybe retreatP' $ fmap fst
|
|
$ collidePointWalls ypos retreatP'
|
|
$ wallsAlongLine ypos retreatP' w
|
|
retreatP = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs
|
|
fireActions = [TurnToward yposoff, Fire, TurnTo ypos, WaitFor t
|
|
,Fire,Fire,Reload,GoalID 0 (WaitFor 20),MakeJudgement]
|
|
fleeActions = [MoveToFor retreatP 50,MakeJudgement]
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] -> ((f,g), replaceGoal [] cr)
|
|
(MakeJudgement:_)
|
|
| not (canSeeFire cpos ypos w) -> ((f,g),replaceAction [] cr)
|
|
| dist cpos ypos > 400 -> ((f,g), replaceAction [MoveToFor ypos 20] cr)
|
|
| dist cpos ypos < 150 -> ((f,g'),replaceAction fleeActions $ crMvBy (3,0) cr)
|
|
| otherwise -> ((f,g'),replaceAction fireActions cr)
|
|
(GoalID i (WaitFor x):gls)
|
|
| x == 0 -> ( (f ,g' ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g' ), replaceAction [GoalID i (WaitFor (x-1))]
|
|
$ strafeCloseSlow ypos cr )
|
|
(WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| x == 0 -> ( (f, g') , replaceAction [] cr)
|
|
| dist p cpos < 10 -> ( (f , g') , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.5 p cr )
|
|
| otherwise -> ( (f , g')
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 3
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_)
|
|
| canSeeFire cpos ypos w -> ((f,g),replaceGoal [[MakeJudgement]] cr)
|
|
| dist p cpos < 10 -> ( (f , g') , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 50] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g') , addAction [MoveToFor q 50] cr )
|
|
_ -> ( (f , g') , replaceAction [] cr )
|
|
(Fire:gls) -> ( (tryUseItem cid . f , g' )
|
|
, replaceAction [] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g') , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g')
|
|
, Just $ strafeCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g')
|
|
, addGoal [[MakeJudgement]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(TurnToward p:_)
|
|
| errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2
|
|
-> ( (f,g') , Just . crTurnTowardSpeed 0.2 p $ cr)
|
|
| errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2
|
|
-> ( (f,g') , Just . crTurnTowardSpeed 0.1 p $ cr)
|
|
| otherwise
|
|
-> ( (f,g') , replaceAction [] . crTurnTo p $ cr)
|
|
(TurnTo p:_) -> ( (f,g') , replaceAction [] . crTurnTo p $ cr)
|
|
|
|
closeToRangeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
closeToRangeAI inRange outRange w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
fireRate = fromMaybe 0 $ wp ^? wpFireRate
|
|
(aimtime,g1) = randomR (80,120) g
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
strafeCloseSlow p | errorAngleVV 22 (p -.- cpos)
|
|
(unitVectorAtAngle (_crDir cr)) < 0.1
|
|
= crTurnTowardSpeed 0.01 p . crMvForward closeDist
|
|
| otherwise
|
|
= crTurnAndStrafeIn inOrOut 0.05 p
|
|
where inOrOut | dist p cpos < inRange = -1.5
|
|
| dist p cpos < outRange = 0
|
|
| otherwise = 1.5
|
|
closeDist | dist p cpos < inRange = -1.5
|
|
| dist p cpos < outRange = 0
|
|
| otherwise = 1.5
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| otherwise -> ( ( f , g )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]]
|
|
cr
|
|
)
|
|
| x == 0 -> ( (f ,g ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g1)
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g) , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 3
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g) , replaceAction [] cr )
|
|
(FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
|
|
, replaceGoal [[Reload
|
|
,PathTo p
|
|
,WaitFor 50
|
|
--,Search 1 ,WaitFor 100
|
|
]]
|
|
cr
|
|
)
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, replaceGoal [[AimAt ypos (fireRate+ aimtime - 80)]]
|
|
$ strafeCloseSlow p cr
|
|
)
|
|
| pathToPointFireable cid p w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, Just $ strafeCloseSlow p cr
|
|
)
|
|
| otherwise -> ( (f , g)
|
|
, replaceGoal [[PathTo p,WaitFor 50 ]] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g)
|
|
, Just $ strafeCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
|
|
| otherwise
|
|
-> ( ( f , g1)
|
|
, replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w)
|
|
, Search (i-1)
|
|
] cr
|
|
)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g1)
|
|
, addGoal [[AimAt ypos (2*aimtime)]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr )
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ strafeCloseSlow p
|
|
cr
|
|
)
|
|
| otherwise
|
|
-> ( (f,g) , replaceAction [AimAt p (i-1)] $ strafeCloseSlow p cr)
|
|
|
|
suppressShooterAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
suppressShooterAI w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
(aimtime,g1) = randomR (80,120) g
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
turnCloseSlow p | errorAngleVV 22 (p -.- cpos)
|
|
(unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.01 p
|
|
| otherwise = crTurnTowardSpeed 0.05 p
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
-- autoFireTweak p | _wpIsAuto wp = Just
|
|
-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]]
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| otherwise -> ( ( f , g )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f ,g ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g1)
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g) , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g) , replaceAction [] cr )
|
|
(FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
|
|
, replaceGoal [[Reload
|
|
,PathTo p
|
|
,WaitFor 50
|
|
--,Search 1 ,WaitFor 100
|
|
]]
|
|
cr
|
|
)
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr
|
|
)
|
|
| pathToPointFireable cid p w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, Just $ turnCloseSlow p cr
|
|
)
|
|
| otherwise -> ( (f , g)
|
|
, replaceGoal [[PathTo p,WaitFor 50 ]] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g)
|
|
, Just $ turnCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
|
|
| otherwise
|
|
-> ( ( f , g1)
|
|
, replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w)
|
|
, Search (i-1)
|
|
] cr
|
|
)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g1)
|
|
, addGoal [[AimAt ypos (2*aimtime)]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr )
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p cr)
|
|
| otherwise
|
|
-> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr)
|
|
|
|
basicShooterAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
basicShooterAI w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
(aimtime,g1) = randomR (80,120) g
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
turnCloseSlow p | errorAngleVV 22 (p -.- cpos)
|
|
(unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.01 p
|
|
| otherwise = crTurnTowardSpeed 0.05 p
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
-- autoFireTweak p | _wpIsAuto wp = Just
|
|
-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]]
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| otherwise -> ( ( f , g )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f ,g ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g1)
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 10 -> ( (f , g) , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g) , replaceAction [] cr )
|
|
(FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
|
|
, replaceGoal [[Reload
|
|
,PathTo p
|
|
,WaitFor 50
|
|
--,Search 1 ,WaitFor 100
|
|
]]
|
|
cr
|
|
)
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr
|
|
)
|
|
| pathToPointFireable cid p w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, Just $ turnCloseSlow p cr
|
|
)
|
|
| otherwise -> ( (f , g)
|
|
, replaceGoal [[PathTo p,WaitFor 50 ]] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g)
|
|
, Just $ turnCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
|
|
| otherwise
|
|
-> ( ( f , g1)
|
|
, replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w)
|
|
, Search (i-1)
|
|
] cr
|
|
)
|
|
(Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( ( f , g1)
|
|
, addGoal [[AimAt ypos (2*aimtime)]] cr
|
|
)
|
|
| dist cpos p > 10
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr )
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p cr)
|
|
| otherwise
|
|
-> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr)
|
|
sniperAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
sniperAI w (f,g) cr =
|
|
let cpos = _crPos cr
|
|
cid = _crID cr
|
|
ypos = _crPos $ you w
|
|
wp = _crInv cr IM.! _crInvSel cr
|
|
(aimtime,g1) = randomR (80,120) g
|
|
noAmmo = 0 == _wpLoadedAmmo wp
|
|
turnCloseSlow p | errorAngleVV 22 (p -.- cpos)
|
|
(unitVectorAtAngle (_crDir cr)) < 0.4
|
|
= crTurnTowardSpeed 0.01 p
|
|
| otherwise = crTurnTowardSpeed 0.05 p
|
|
replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
|
|
addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs)
|
|
replaceAction newActions
|
|
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
|
addAction newActions
|
|
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
|
-- autoFireTweak p | _wpIsAuto wp = Just
|
|
-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]]
|
|
in --if _crHP cr <= 0 then killCr w f cr else
|
|
case head $ _goals $ _crState cr of
|
|
[] | canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| otherwise -> ( ( f , g )
|
|
, replaceGoal [] cr
|
|
)
|
|
(WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 )
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f ,g ), replaceAction [] cr )
|
|
| otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr )
|
|
(MoveToFor p x:gls)
|
|
| canSeeFire cpos ypos w -> ( (f , g1)
|
|
, replaceGoal [[AimAt ypos aimtime]] cr
|
|
)
|
|
| x == 0 -> ( (f , g)
|
|
, replaceAction [] cr
|
|
)
|
|
| dist p cpos < 1 -> ( (f , g) , replaceAction [] cr)
|
|
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
|
| otherwise -> ( (f , g)
|
|
, replaceAction [MoveToFor p (x-1)] $ crMvForward 2
|
|
$ crTurnTowardSpeed 0.05 p cr )
|
|
(PathTo p:_) | dist p cpos < 1 -> ( (f , g) , replaceAction [] cr )
|
|
| hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
|
|
| otherwise -> case pointTowardsGoal cpos p w of
|
|
Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
|
|
_ -> ( (f , g) , replaceAction [] cr )
|
|
(FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
|
|
, replaceGoal [[Reload
|
|
,WaitFor 50
|
|
--,Search 1 ,WaitFor 100
|
|
]]
|
|
cr
|
|
)
|
|
| canSeeFireVisionAll cid (_yourID w) w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr
|
|
)
|
|
| pathToPointFireable cid p w
|
|
-> ( (tryUseItem cid . f , g)
|
|
, Just $ turnCloseSlow p cr
|
|
)
|
|
| otherwise -> ( (f , g)
|
|
, replaceGoal [[WaitFor 50 ]] cr
|
|
)
|
|
(Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
|
|
| canSeeFireVisionAny cid (_yourID w) w
|
|
-> ( (f , g)
|
|
, Just $ turnCloseSlow ypos cr
|
|
) -- no longer chase if see you when reloading
|
|
-- $ replaceAction [] w
|
|
| otherwise -> ( (f , g) , Just cr)
|
|
(Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
|
|
| otherwise
|
|
-> ( ( f , g1)
|
|
, replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w)
|
|
, Search (i-1)
|
|
] cr
|
|
)
|
|
(Guard p p':_) | canSeeFireVision cid (_yourID w) w
|
|
-> ( ( f , g1)
|
|
, addGoal [[AimAt ypos (2*aimtime)]] cr
|
|
)
|
|
| dist cpos p > 1
|
|
-> ( (f,g) , addGoal [[PathTo p]] cr)
|
|
| errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-> ( (f,g)
|
|
,Just $ crTurnTowardSpeed 0.05 p' cr)
|
|
| otherwise -> ( (f,g) ,Just cr)
|
|
(InitGuard :_) -> ( (f,g)
|
|
,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
|
|
)
|
|
(AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr )
|
|
| canSeeFireVision cid (_yourID w) w
|
|
-> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ crTurnTowardSpeed 0.2 p cr)
|
|
| otherwise
|
|
-> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr)
|
|
--closeShooterAI :: Int -> World -> World
|
|
--closeShooterAI cid w = let cr = _creatures w IM.! cid
|
|
-- cpos = _crPos cr
|
|
-- ypos = _crPos $ you w
|
|
-- wp = _crInv cr IM.! _crInvSel cr
|
|
-- noAmmo = 0 == _wpLoadedAmmo wp
|
|
-- turnCloseSlow p | errorAngleVV 22 (p -.- cpos)
|
|
-- (unitVectorAtAngle (_crDir cr)) < 0.4
|
|
-- = turnTowardSpeed 0.01 p cid
|
|
-- | otherwise = turnTowardSpeed 0.05 p cid
|
|
-- replaceGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
-- (\gs -> newGoals ++ tail gs)
|
|
-- addGoal newGoals = over (creatures . ix cid . crState . goals)
|
|
-- (\gs -> newGoals ++ gs)
|
|
-- replaceAction newActions = over (creatures . ix cid . crState . goals)
|
|
-- (\((_:as):ass) -> (newActions ++ as):ass)
|
|
-- addAction newActions = over (creatures . ix cid . crState . goals)
|
|
-- (\(as:ass) -> (newActions++as):ass)
|
|
-- autoFireTweak p | _wpIsAuto wp = id
|
|
-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]]
|
|
-- in if _crHP cr <= 0 then killCr cid w else
|
|
-- case head $ _goals $ _crState cr of
|
|
-- [] | canSeeAny cid (_yourID w) w
|
|
-- -> replaceGoal [[AimAt ypos 50]] w
|
|
-- | otherwise -> replaceGoal [] w
|
|
-- (WaitFor x:gls)| canSeeAny cid (_yourID w) w
|
|
-- -> replaceGoal [[AimAt ypos 50]] w
|
|
-- | x == 0 -> replaceAction [] w
|
|
-- | otherwise -> replaceAction [WaitFor (x-1)] w
|
|
-- (MoveToFor p x:gls)
|
|
-- | canSeeAny cid (_yourID w) w -> replaceGoal [[AimAt ypos 50]] w
|
|
-- | x == 0 || not (canSeePoint cid p w) -> replaceAction [] w
|
|
-- | dist p cpos < 10 -> replaceAction [] w
|
|
-- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-- -> replaceAction [MoveToFor p (x-1)] $ turnTowardSpeed 0.05 p cid w
|
|
-- | otherwise -> replaceAction [MoveToFor p (x-1)]
|
|
-- $ mvForward speed cid $ turnTowardSpeed 0.05 p cid w
|
|
-- (PathTo p:_) | dist p cpos < 10 -> replaceAction [] w
|
|
-- | canSeePoint cid p w -> addAction [MoveToFor p 100] w
|
|
-- | otherwise -> case pointTowardsGoal cpos p w of
|
|
-- Just q -> addAction [MoveToFor q 100] w
|
|
-- _ -> replaceAction [] w
|
|
-- (MoveFire mp tp:gls)
|
|
-- | noAmmo -> replaceGoal [[Reload
|
|
-- ,MoveFire mp tp
|
|
-- ]]
|
|
-- $ tryUseItem cid w
|
|
-- | not $ canSeeAll cid (_yourID w) w -> replaceAction [PathTo tp,Search 1] w
|
|
-- | dist cpos mp < 10 -> replaceAction [MoveFire ypos ypos] $ turnCloseSlow tp
|
|
-- $ tryUseItem cid w
|
|
-- | otherwise -> replaceAction [MoveFire mp ypos]
|
|
-- $ turnCloseSlow tp $ strafeTo speed mp cid
|
|
-- $ tryUseItem cid w
|
|
-- (Reload:gls) | _wpReloadState wp == 0 -> replaceAction [] w
|
|
-- | canSeeAny cid (_yourID w) w -> turnCloseSlow ypos
|
|
-- $ replaceAction [Reload,MoveFire ypos ypos,Search 1]
|
|
-- $ replaceAction [] w
|
|
-- | otherwise -> w
|
|
-- (Guard p p':_)| canSeeAny cid (_yourID w) w
|
|
-- -> addGoal [[AimAt ypos 50]] w
|
|
-- | dist cpos p > 10
|
|
-- -> addGoal [[PathTo p]] w
|
|
-- | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
|
|
-- -> turnTowardSpeed 0.05 p' cid w
|
|
-- | otherwise -> w
|
|
-- (InitGuard :_) -> replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] w
|
|
-- (AimAt p i:_) | i == 0 -> replaceAction [MoveFire p p] w
|
|
-- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
|
-- -> replaceAction [AimAt p (i-1)] $ turnTowardSpeed 0.05 p cid w
|
|
-- | canSeeAll cid (_yourID w) w
|
|
-- -> replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p
|
|
-- $ strafeTo speed p cid w
|
|
-- | otherwise
|
|
-- -> replaceGoal [[AimAt p (i-1),Search 1]] $ turnCloseSlow p
|
|
-- $ strafeTo speed p cid w
|
|
-- (Search i:gls) | i == 0 -> replaceAction [] w
|
|
-- | otherwise -> replaceAction [PathTo (randomPointXStepsFrom 3 cpos w)
|
|
-- ] $ over randGen (snd . next) w
|
|
-- where speed = 2
|
|
|
|
strafeTo :: Float -> Point2 -> Int -> World -> World
|
|
strafeTo speed targPos cid w = over (creatures . ix cid . crPos) (+.+ q) w
|
|
where q = (*.*) (speed * equipFactor * wpFactor)
|
|
$ safeNormalizeV $ (targPos -.- _crPos cr)
|
|
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
|
|
cr = _creatures w IM.! cid
|
|
wpFactor = _itAimingSpeed (_crInv cr IM.! _crInvSel cr)
|
|
|
|
randomGraphStep :: RandomGen g => Int -> Gr a b -> State g (Maybe Int)
|
|
randomGraphStep n g =
|
|
do let ns = neighbors g n
|
|
i <- state $ randomR (0,length ns - 1)
|
|
case ns of [] -> return Nothing
|
|
_ -> return $ Just $ ns !! i
|
|
randomGraphStepRestricted :: RandomGen g => Int -> [Int] -> Gr a b -> State g (Maybe Int)
|
|
randomGraphStepRestricted n notns g =
|
|
do let ns = neighbors g n \\ notns
|
|
i <- state $ randomR (0,length ns - 1)
|
|
case ns of [] -> return Nothing
|
|
_ -> return $ Just $ ns !! i
|
|
|
|
---- continues a walk from a list of points, without repetitions
|
|
---- supposes that the list is non-empty
|
|
randomGraphWalk :: RandomGen g => [Int] -> Gr a b -> State g [Int]
|
|
randomGraphWalk (n:ns) g =
|
|
do next <- randomGraphStepRestricted n ns g
|
|
case next of Nothing -> return (n:ns)
|
|
Just n' -> randomGraphWalk (n':n:ns) g
|
|
|
|
randomPointXStepsFrom :: Int -> Point2 -> World -> Point2
|
|
randomPointXStepsFrom i p w =
|
|
let g = _pathGraph w
|
|
ns = labNodes g
|
|
mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
|
|
in case mp of Nothing -> p
|
|
Just (n,_) -> fromJust $ lab g
|
|
(last $ take i
|
|
$ evalState (randomGraphWalk [n] g)
|
|
$ _randGen w)
|
|
|
|
randomPointsXStepsFrom :: Int -> Point2 -> World -> [Point2]
|
|
randomPointsXStepsFrom i p w =
|
|
let g = _pathGraph w
|
|
ns = labNodes g
|
|
mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
|
|
in case mp of Nothing -> [p]
|
|
Just (n,_) -> mapMaybe (lab g )
|
|
(take i
|
|
$ evalState (randomGraphWalk [n] g)
|
|
$ _randGen w)
|
|
|
|
|
|
errorNormalizeVAI :: Point2 -> Point2
|
|
errorNormalizeVAI (0,0) = error $ "problem with function: errorNormalizeVAI in DodgeAIs"
|
|
errorNormalizeVAI p = normalizeV p
|
|
|
|
splitCritPict' :: Int -> Picture
|
|
splitCritPict' i = pictures $ (++) [color (greyN 0.1) $ circleSolid r,color green $ circLine r] $ concatMap (\p -> map (uncurry translate p) pic) $ take (2^(i-1)) rps
|
|
where pic = [color green $ circLine 6]
|
|
rps = fst $ runState ((sequence . repeat . randInCirc) (r-6)) $ mkStdGen 0
|
|
r = sqrt ((fromIntegral i) * spCrRadFac)
|
|
|
|
splitCritPict :: Float -> Picture
|
|
splitCritPict x = pictures [color (greyN 0.8) $ circleSolid x, color green $ circLine x]
|
|
splitCritCorpse :: Float -> Picture
|
|
splitCritCorpse x = color (greyN 0.2) $ circleSolid x
|
|
spCrRadFac = 8^2
|
|
|
|
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
yourControl w (f,g) cr = ( (mouseActionsWorld (_mouseButtons w) . f, g)
|
|
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
|
|
)
|
|
where strafeSpeed = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
|
|
speed = 3 * equipFactor
|
|
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
|
|
|
|
wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature
|
|
wasdWithAiming w speed aimSpeed i cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
|
|
&& diffAngles mouseDir (argV mov) < pi/3
|
|
= over crPos (+.+ (0.2 *.* mov))
|
|
-- $ set ( creatures . ix i . crDir) (argV mov)
|
|
$ set crDir mouseDir
|
|
$ set (crState . stance . carriage) (Boosting mov)
|
|
cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
|
|
= set crDir mouseDir
|
|
$ set (crState . stance . carriage) Floating
|
|
cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving
|
|
= over crPos (+.+ (0.2 *.* mov))
|
|
-- $ set ( creatures . ix i . crDir) (argV mov)
|
|
-- $ set ( creatures . ix i . crDir) mouseDir
|
|
$ over crDir (flip fromMaybe dir)
|
|
$ set (crState . stance . carriage) (Boosting mov)
|
|
cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isAiming
|
|
= set (crState . stance . carriage) Floating
|
|
$ set crDir mouseDir
|
|
cr
|
|
| any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
|
|
= set (crState . stance . carriage) Floating
|
|
cr
|
|
| isAiming
|
|
= -- stopSoundFrom (CrSound i) $
|
|
stepForward' aimSpeed
|
|
$ over crPos (+.+ (aimSpeed *.* mov))
|
|
$ set crDir mouseDir
|
|
cr
|
|
| isMoving
|
|
= -- continueOrLoopFrom (CrSound i) twoStepSound $
|
|
stepForward' speed
|
|
$ over ( crPos) (+.+ (speed *.* mov))
|
|
$ over ( crDir) (flip fromMaybe dir)
|
|
cr
|
|
| otherwise
|
|
= -- stopSoundFrom (CrSound i) $
|
|
over ( crDir) (flip fromMaybe dir)
|
|
cr
|
|
where (mov',dir') = wasdComp $ view keys w
|
|
(mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
|
|
isMoving = mov' /= (0,0)
|
|
isAiming = (_posture $ _stance $ _crState cr) == Aiming
|
|
mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment of
|
|
Just (Just (ItScope {_scopePos = p})) -> normalizeAngle $ argV
|
|
$ p +.+ 2 / _cameraZoom w
|
|
*.* rotateV (_cameraRot w) (_mousePos w)
|
|
_ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
|
|
|
|
|
|
wasdM :: SDL.Keycode -> Point2
|
|
wasdM SDL.KeycodeW = (0,1)
|
|
wasdM SDL.KeycodeS = (0,-1)
|
|
wasdM SDL.KeycodeD = (1,0)
|
|
wasdM SDL.KeycodeA = (-1,0)
|
|
wasdM _ = (0,0)
|
|
|
|
wasdComp :: S.Set SDL.Keycode -> (Point2,Maybe Float)
|
|
wasdComp ks = f $ foldr ( (+.+) . wasdM ) (0,0) ks
|
|
where f (0,0) = ((0,0), Nothing)
|
|
f p = (errorNormalizeV 46 p, Just $ argV p)
|
|
|
|
----------------
|
|
circLine x = line [(0,0),(x,0)]
|
|
|
|
sigmoid x = x/sqrt(1+x^2)
|