AI refactor
This commit is contained in:
+1
-720
@@ -1,7 +1,5 @@
|
||||
module Dodge.AIs
|
||||
( chargeAI
|
||||
, dodgeAI
|
||||
, spawnerAI
|
||||
(
|
||||
) where
|
||||
import Dodge.Creature.Stance.Data
|
||||
import Dodge.Creature.State.Data
|
||||
@@ -37,29 +35,6 @@ import Control.Concurrent
|
||||
import System.Random
|
||||
import Foreign.ForeignPtr
|
||||
|
||||
expandToAI
|
||||
:: ( World -> StdGen -> Creature -> (World -> World, StdGen, Creature) )
|
||||
-> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
||||
expandToAI ai w (f,g) cr =
|
||||
let (sideE, g', cr') = ai w g cr
|
||||
in ((sideE . f, g'), Just cr')
|
||||
|
||||
replaceGoal :: [[Impulse]] -> Creature -> Creature
|
||||
replaceGoal newImpulses = over (crState . goals) ((newImpulses ++) . tail)
|
||||
|
||||
addGoal :: [[Impulse]] -> Creature -> Creature
|
||||
addGoal newImpulses = over (crState . goals) (newImpulses ++)
|
||||
|
||||
replaceImpulse :: [Impulse] -> Creature -> Creature
|
||||
replaceImpulse newActions = over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
|
||||
addImpulse :: [Impulse] -> Creature -> Creature
|
||||
addImpulse newActions = over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
||||
|
||||
|
||||
|
||||
factionIs :: Faction -> Creature -> Bool
|
||||
factionIs f c = (_crFaction $ c) == f
|
||||
|
||||
lineOrth :: Point2 -> IM.IntMap Creature -> Point2 -> Point2
|
||||
lineOrth ypos crs cpos = p
|
||||
@@ -209,702 +184,8 @@ spreadOut ypos crs cpos = p
|
||||
---- $ replaceImpulse [WaitFor (x-1)] w
|
||||
---- | otherwise -> replaceImpulse [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 newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
|
||||
addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
|
||||
replaceImpulse newActions
|
||||
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
addImpulse newActions
|
||||
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
||||
|
||||
needChild = length (filter (\cr' -> (cr' ^? crFaction) == 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)
|
||||
,replaceImpulse [WaitFor 200] $ over crDir (+ 1) cr
|
||||
)
|
||||
| canSee cid (_yourID w) w
|
||||
-> ( (f , g)
|
||||
,replaceImpulse [WaitFor (max 0 (x-1))]
|
||||
$ set (crDir) (argV (ypos -.- cpos)) cr )
|
||||
| otherwise -> ( (f , g)
|
||||
,replaceImpulse [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 (Dodge.Base.newKey crs)
|
||||
( set crFaction fact
|
||||
$ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = Dodge.Base.newKey crs}
|
||||
)
|
||||
crs
|
||||
|
||||
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 newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
|
||||
addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
|
||||
replaceImpulse newActions
|
||||
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
addImpulse newActions
|
||||
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
||||
-- autoFireTweak p | _wpIsAuto wp = Just
|
||||
-- | otherwise = replaceGoal [[AimAt p (_itUseRate 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 ), replaceImpulse [] cr )
|
||||
| otherwise -> ( (f ,g ), replaceImpulse [WaitFor (x-1)] cr )
|
||||
(MoveToFor p x:gls)
|
||||
| canSeeFire cpos ypos w -> ( (f , g1)
|
||||
, replaceGoal [[AimAt ypos aimtime]] cr
|
||||
)
|
||||
| x == 0 -> ( (f , g)
|
||||
, replaceImpulse [] cr
|
||||
)
|
||||
| dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
||||
-> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
||||
| otherwise -> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2
|
||||
$ crTurnTowardSpeed 0.05 p cr )
|
||||
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr )
|
||||
| hasLOS cpos p w -> ( (f , g) , addImpulse [MoveToFor p 100] cr )
|
||||
| otherwise -> case pointTowardsImpulse cpos p w of
|
||||
Just q -> ( (f , g) , addImpulse [MoveToFor q 100] cr )
|
||||
_ -> ( (f , g) , replaceImpulse [] 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) , replaceImpulse [] cr )
|
||||
| canSeeFireVisionAny cid (_yourID w) w
|
||||
-> ( (f , g)
|
||||
, Just $ strafeCloseSlow ypos cr
|
||||
) -- no longer chase if see you when reloading
|
||||
-- $ replaceImpulse [] w
|
||||
| otherwise -> ( (f , g) , Just cr)
|
||||
(Search i:gls) | i == 0 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| otherwise
|
||||
-> ( ( f , g1)
|
||||
, replaceImpulse [ 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) , replaceImpulse [FireAt p] cr )
|
||||
| canSeeFireVisionAll cid (_yourID w) w
|
||||
-> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ strafeCloseSlow p
|
||||
cr
|
||||
)
|
||||
| otherwise
|
||||
-> ( (f,g) , replaceImpulse [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 newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
|
||||
addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
|
||||
replaceImpulse newActions
|
||||
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
addImpulse 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) , replaceImpulse [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), replaceImpulse [] cr)
|
||||
[] | canSeeFireVisionAny cid (_yourID w) w
|
||||
-> ( ( f , g' ) , addImpulse [MoveTo ypos] cr)
|
||||
| otherwise -> ( ( f , g' ) , Just cr)
|
||||
(WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceImpulse [] cr )
|
||||
| otherwise -> ( (f ,g' ), replaceImpulse [WaitFor (x-1)] cr )
|
||||
(MoveToFor p x:gls)
|
||||
| canSeeFire cpos ypos w -> ( (f , g')
|
||||
, replaceImpulse [MoveTo ypos] cr
|
||||
)
|
||||
| x == 0 -> ( (f , g')
|
||||
, replaceImpulse [] cr
|
||||
)
|
||||
| dist p cpos < 10 -> ( (f , g') , replaceImpulse [] cr)
|
||||
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
||||
-> ( (f , g')
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
||||
| otherwise -> ( (f , g')
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2
|
||||
$ crTurnTowardSpeed 0.05 p cr )
|
||||
(PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceImpulse [] cr )
|
||||
| hasLOS cpos p w -> ( (f , g') , addImpulse [MoveToFor p 100] cr )
|
||||
| otherwise -> case pointTowardsImpulse cpos p w of
|
||||
Just q -> ( (f , g') , addImpulse [MoveToFor q 100] cr )
|
||||
_ -> ( (f , g') , replaceImpulse [] cr )
|
||||
(Init:_) -> ((f,g), replaceImpulse [] 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 newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
|
||||
addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
|
||||
replaceImpulse newActions
|
||||
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
addImpulse 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
|
||||
: (ImpulseID 0 (MoveByFor (3,0) 15))
|
||||
: (concatMap (\t -> [ImpulseID 0 (MoveByFor (3,0) t),Fire]) ts)
|
||||
retreatActions = TurnToward retreatOffset
|
||||
:(ImpulseID 0 (MoveByFor (-3,0) 9))
|
||||
: (concatMap (\t -> [ImpulseID 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'), replaceImpulse [] . crMvBy p $ cr)
|
||||
(MoveByFor p i:_) -> ((f,g'), replaceImpulse [MoveByFor p (i-1)] . crMvBy p $ cr)
|
||||
(Fire:_) -> ((tryUseItem cid . f,g'), replaceImpulse [] cr)
|
||||
(ImpulseID i (MoveByFor p 0):_) -> ((f,g'), replaceImpulse [] . crMvBy p $ cr)
|
||||
(ImpulseID i (MoveByFor p x):_)
|
||||
| canSeeFire cpos (aCrPos i w) w
|
||||
-> ( (f,g')
|
||||
, replaceImpulse [ImpulseID i (MoveByFor p (x-1))]
|
||||
. crMvBy p
|
||||
. crTurnTowardSpeed 0.01 (aCrPos i w)
|
||||
$ cr
|
||||
)
|
||||
| otherwise
|
||||
-> ( (f,g')
|
||||
, replaceImpulse [ImpulseID 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')
|
||||
, replaceImpulse []
|
||||
$ cr
|
||||
)
|
||||
[] | noAmmo -> ( (tryUseItem cid . f, g') , addImpulse [Reload] cr)
|
||||
| canSeeFireVisionAny cid (_yourID w) w
|
||||
-> ( ( f , g' ) , addImpulse (WaitFor 9:fireActions) $ updateSearch cr)
|
||||
| otherwise -> ( ( f , g' ) , replaceGoal [] cr)
|
||||
(WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceImpulse [] cr )
|
||||
| otherwise -> ( (f ,g' ), replaceImpulse [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')
|
||||
, replaceImpulse [] cr
|
||||
)
|
||||
| dist p cpos < 10 -> ( (f , g') , replaceImpulse [] cr)
|
||||
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
||||
-> ( (f , g')
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
||||
| otherwise -> ( (f , g')
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2
|
||||
$ crTurnTowardSpeed 0.05 p cr )
|
||||
(PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceImpulse [] cr )
|
||||
| hasLOS cpos p w -> ( (f , g') , addImpulse [MoveToFor p 100] cr )
|
||||
| otherwise -> case pointTowardsImpulse cpos p w of
|
||||
Just q -> ( (f , g') , addImpulse [MoveToFor q 100] cr )
|
||||
_ -> ( (f , g') , replaceImpulse [] cr )
|
||||
(Reload:_) | _wpReloadState wp == 0 -> ( (f , g') , replaceImpulse [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 newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
|
||||
addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
|
||||
replaceImpulse newActions
|
||||
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
addImpulse newActions
|
||||
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
||||
-- autoFireTweak p | _wpIsAuto wp = Just
|
||||
-- | otherwise = replaceGoal [[AimAt p (_itUseRate 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 ), replaceImpulse [] cr )
|
||||
| otherwise -> ( (f ,g ), replaceImpulse [WaitFor (x-1)] cr )
|
||||
(MoveToFor p x:gls)
|
||||
| canSeeFire cpos ypos w -> ( (f , g1)
|
||||
, replaceGoal [[AimAt ypos aimtime]] cr
|
||||
)
|
||||
| x == 0 -> ( (f , g)
|
||||
, replaceImpulse [] cr
|
||||
)
|
||||
| dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
||||
-> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
||||
| otherwise -> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2
|
||||
$ crTurnTowardSpeed 0.05 p cr )
|
||||
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr )
|
||||
| hasLOS cpos p w -> ( (f , g) , addImpulse [MoveToFor p 100] cr )
|
||||
| otherwise -> case pointTowardsImpulse cpos p w of
|
||||
Just q -> ( (f , g) , addImpulse [MoveToFor q 100] cr )
|
||||
_ -> ( (f , g) , replaceImpulse [] 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) , replaceImpulse [] cr )
|
||||
| canSeeFireVisionAny cid (_yourID w) w
|
||||
-> ( (f , g)
|
||||
, Just $ strafeCloseSlow ypos cr
|
||||
) -- no longer chase if see you when reloading
|
||||
-- $ replaceImpulse [] w
|
||||
| otherwise -> ( (f , g) , Just cr)
|
||||
(Search i:gls) | i == 0 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| otherwise
|
||||
-> ( ( f , g1)
|
||||
, replaceImpulse [ 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) , replaceImpulse [FireAt p] cr )
|
||||
| canSeeFireVisionAll cid (_yourID w) w
|
||||
-> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ strafeCloseSlow p
|
||||
cr
|
||||
)
|
||||
| otherwise
|
||||
-> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ strafeCloseSlow 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 ^? itUseRate
|
||||
(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 newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
|
||||
addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
|
||||
replaceImpulse newActions
|
||||
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
addImpulse 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 ), replaceImpulse [] cr )
|
||||
| otherwise -> ( (f ,g ), replaceImpulse [WaitFor (x-1)] cr )
|
||||
(MoveToFor p x:gls)
|
||||
| canSeeFire cpos ypos w -> ( (f , g1)
|
||||
, replaceGoal [[AimAt ypos aimtime]] cr
|
||||
)
|
||||
| x == 0 -> ( (f , g)
|
||||
, replaceImpulse [] cr
|
||||
)
|
||||
| dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
||||
-> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
||||
| otherwise -> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crMvForward 3
|
||||
$ crTurnTowardSpeed 0.05 p cr )
|
||||
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr )
|
||||
| hasLOS cpos p w -> ( (f , g) , addImpulse [MoveToFor p 100] cr )
|
||||
| otherwise -> case pointTowardsImpulse cpos p w of
|
||||
Just q -> ( (f , g) , addImpulse [MoveToFor q 100] cr )
|
||||
_ -> ( (f , g) , replaceImpulse [] 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) , replaceImpulse [] cr )
|
||||
| canSeeFireVisionAny cid (_yourID w) w
|
||||
-> ( (f , g)
|
||||
, Just $ strafeCloseSlow ypos cr
|
||||
) -- no longer chase if see you when reloading
|
||||
-- $ replaceImpulse [] w
|
||||
| otherwise -> ( (f , g) , Just cr)
|
||||
(Search i:gls) | i == 0 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| otherwise
|
||||
-> ( ( f , g1)
|
||||
, replaceImpulse [ 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) , replaceImpulse [FireAt p] cr )
|
||||
| canSeeFireVisionAll cid (_yourID w) w
|
||||
-> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ strafeCloseSlow p
|
||||
cr
|
||||
)
|
||||
| otherwise
|
||||
-> ( (f,g) , replaceImpulse [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 newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
|
||||
addGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
|
||||
replaceImpulse newActions
|
||||
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
|
||||
addImpulse newActions
|
||||
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
|
||||
-- autoFireTweak p | _wpIsAuto wp = Just
|
||||
-- | otherwise = replaceGoal [[AimAt p (_itUseRate 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 ), replaceImpulse [] cr )
|
||||
| otherwise -> ( (f ,g ), replaceImpulse [WaitFor (x-1)] cr )
|
||||
(MoveToFor p x:gls)
|
||||
| canSeeFire cpos ypos w -> ( (f , g1)
|
||||
, replaceGoal [[AimAt ypos aimtime]] cr
|
||||
)
|
||||
| x == 0 -> ( (f , g)
|
||||
, replaceImpulse [] cr
|
||||
)
|
||||
| dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
|
||||
-> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr )
|
||||
| otherwise -> ( (f , g)
|
||||
, replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2
|
||||
$ crTurnTowardSpeed 0.05 p cr )
|
||||
(PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceImpulse [] cr )
|
||||
| hasLOS cpos p w -> ( (f , g) , addImpulse [MoveToFor p 100] cr )
|
||||
| otherwise -> case pointTowardsImpulse cpos p w of
|
||||
Just q -> ( (f , g) , addImpulse [MoveToFor q 100] cr )
|
||||
_ -> ( (f , g) , replaceImpulse [] 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) , replaceImpulse [] cr )
|
||||
| canSeeFireVisionAny cid (_yourID w) w
|
||||
-> ( (f , g)
|
||||
, Just $ turnCloseSlow ypos cr
|
||||
) -- no longer chase if see you when reloading
|
||||
-- $ replaceImpulse [] w
|
||||
| otherwise -> ( (f , g) , Just cr)
|
||||
(Search i:gls) | i == 0 -> ( (f , g) , replaceImpulse [] cr)
|
||||
| otherwise
|
||||
-> ( ( f , g1)
|
||||
, replaceImpulse [ 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) , replaceImpulse [FireAt p] cr )
|
||||
| canSeeFireVisionAll cid (_yourID w) w
|
||||
-> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ turnCloseSlow p cr)
|
||||
| otherwise
|
||||
-> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ turnCloseSlow p cr)
|
||||
|
||||
errorNormalizeVAI :: Point2 -> Point2
|
||||
errorNormalizeVAI (0,0) = error "problem with function: errorNormalizeVAI in DodgeAIs"
|
||||
errorNormalizeVAI p = normalizeV p
|
||||
|
||||
----------------
|
||||
sigmoid x = x/sqrt(1+x^2)
|
||||
|
||||
@@ -506,3 +506,5 @@ isAnimate :: Creature -> Bool
|
||||
isAnimate cr = case _crActionPlan cr of
|
||||
Inanimate -> False
|
||||
_ -> True
|
||||
|
||||
sigmoid x = x/sqrt(1+x^2)
|
||||
|
||||
+7
-19
@@ -3,6 +3,8 @@ module Dodge.Creature
|
||||
, module Dodge.Creature.Inanimate
|
||||
, launcherCrit
|
||||
, pistolCrit
|
||||
, ltAutoCrit
|
||||
, spreadGunCrit
|
||||
)
|
||||
where
|
||||
import Dodge.Creature.Stance.Data
|
||||
@@ -16,6 +18,8 @@ import Dodge.Creature.SetTarget
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Creature.LauncherCrit
|
||||
import Dodge.Creature.PistolCrit
|
||||
import Dodge.Creature.LtAutoCrit
|
||||
import Dodge.Creature.SpreadGunCrit
|
||||
import Dodge.Data
|
||||
import Dodge.AIs
|
||||
import Dodge.Default
|
||||
@@ -56,8 +60,8 @@ import Control.Concurrent
|
||||
|
||||
spawnerCrit :: Creature
|
||||
spawnerCrit = defaultCreature
|
||||
{ _crUpdate = stateUpdate $ spawnerAI chaseCrit
|
||||
, _crHP = 300
|
||||
{ --_crUpdate = stateUpdate $ spawnerAI chaseCrit
|
||||
_crHP = 300
|
||||
, _crPict = basicCrPict blue
|
||||
, _crState = defaultState {_goals = [[WaitFor 0]] }
|
||||
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
||||
@@ -67,10 +71,7 @@ smallChaseCrit = defaultCreature
|
||||
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
|
||||
, _crHP = 1
|
||||
, _crRad = 4
|
||||
, _crPict = basicCrPict green
|
||||
, _crState = defaultState
|
||||
{_goals = [[Wait]]
|
||||
}
|
||||
, _crPict = basicCrPict yellow
|
||||
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
||||
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4
|
||||
, _crFaction = ColorFaction green
|
||||
@@ -80,9 +81,6 @@ chaseCrit = defaultCreature
|
||||
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
|
||||
, _crHP = 300
|
||||
, _crPict = basicCrPict green
|
||||
, _crState = defaultState
|
||||
{_goals = [[Wait]]
|
||||
}
|
||||
, _crInv = IM.empty
|
||||
, _crMeleeCooldown = Just 0
|
||||
, _crFaction = ColorFaction green
|
||||
@@ -171,16 +169,6 @@ multGunCrit = defaultCreature
|
||||
, _crGoal = []
|
||||
}
|
||||
}
|
||||
spreadGunCrit :: Creature
|
||||
spreadGunCrit = defaultCreature
|
||||
{ _crPict = basicCrPict red
|
||||
, _crUpdate = stateUpdate chargeAI
|
||||
, _crInv = IM.fromList [(0,spreadGun),(1,medkit 100)]
|
||||
, _crInvSel = 0
|
||||
, _crRad = 10
|
||||
, _crState = defaultState {_goals = [[Init]]}
|
||||
, _crHP = 300
|
||||
}
|
||||
autoCrit :: Creature
|
||||
autoCrit = defaultCreature
|
||||
{ _crPict = basicCrPict red
|
||||
|
||||
@@ -0,0 +1,75 @@
|
||||
module Dodge.Creature.LtAutoCrit
|
||||
( ltAutoCrit
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Default
|
||||
import Dodge.Creature.Picture
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Creature.ActionRat
|
||||
import Dodge.Creature.ChooseTarget
|
||||
import Dodge.Creature.SetTarget
|
||||
import Dodge.Creature.Rationality
|
||||
import Dodge.Creature.AlertLevel
|
||||
import Dodge.Creature.State
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.Item.Weapon
|
||||
import Dodge.Item.Consumable
|
||||
import Geometry
|
||||
import Picture
|
||||
import Dodge.RandomHelp
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
|
||||
|
||||
ltAutoCrit :: Creature
|
||||
ltAutoCrit = defaultCreature
|
||||
{ _crPict = basicCrPict red
|
||||
, _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
|
||||
[ performActions
|
||||
, watchUpdateStrat
|
||||
[ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0)
|
||||
[DoActionIf (not . crIsAiming) DrawWeapon
|
||||
,DoActionThen
|
||||
(DoActionWhile crHasTargetLOS $ ArbitraryAction chooseMovement)
|
||||
(DoImpulses [ChangeStrategy WatchAndWait])
|
||||
]
|
||||
)
|
||||
, (crAwayFromPost, goToPostStrat)
|
||||
]
|
||||
, basicPerceptionUpdate [0]
|
||||
, doStrategyActions
|
||||
, reloadOverride
|
||||
, targetYouWhenCognizant
|
||||
, overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
|
||||
$ \ _ -> crActionPlan . crStrategy .~ WatchAndWait
|
||||
]
|
||||
, _crActionPlan = ActionPlan
|
||||
{ _crImpulse = []
|
||||
, _crAction = []
|
||||
, _crStrategy = StrategyActions WatchAndWait [StartSentinelPost]
|
||||
, _crGoal = []
|
||||
}
|
||||
, _crInv = IM.fromList [(0,ltAutoGun),(1,medkit 100)]
|
||||
, _crInvSel = 0
|
||||
, _crRad = 10
|
||||
, _crHP = 500
|
||||
}
|
||||
|
||||
chooseMovement :: Creature -> World -> Action
|
||||
chooseMovement cr w
|
||||
| dist cpos p > 200 = DoImpulses [UseItem,TurnToward p 0.05 , MoveForward 3]
|
||||
| dist cpos p < 80 = DoImpulses [UseItem,TurnToward p 0.05, MoveForward (-3) ]
|
||||
| errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
|
||||
= DoImpulses [UseItem,TurnToward p' 0.01, Move (0,3)]
|
||||
| otherwise
|
||||
= DoImpulses [UseItem,TurnToward p' 0.05, Move (0,3)]
|
||||
where
|
||||
cpos = _crPos cr
|
||||
tcr = _creatures w IM.! 0
|
||||
p = _crPos tcr
|
||||
v = vNormal $ p -.- cpos
|
||||
p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v))
|
||||
@@ -16,10 +16,13 @@ import Dodge.Item.Weapon
|
||||
import Dodge.Item.Consumable
|
||||
import Geometry
|
||||
import Picture
|
||||
import Dodge.RandomHelp
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
|
||||
pistolCrit :: Creature
|
||||
pistolCrit = defaultCreature
|
||||
@@ -27,7 +30,7 @@ pistolCrit = defaultCreature
|
||||
, _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
|
||||
[ performActions
|
||||
, watchUpdateStrat
|
||||
[ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) [chooseMovement cr w])
|
||||
[ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) [DoActionIf (not . crIsAiming) DrawWeapon,chooseMovement cr w])
|
||||
, (crAwayFromPost, goToPostStrat)
|
||||
]
|
||||
, basicPerceptionUpdate [0]
|
||||
@@ -48,15 +51,58 @@ pistolCrit = defaultCreature
|
||||
, _crRad = 10
|
||||
, _crHP = 500
|
||||
}
|
||||
|
||||
chooseMovement :: Creature -> World -> Action
|
||||
chooseMovement cr w = undefined
|
||||
chooseMovement cr w = chooseMovement' cr w
|
||||
`DoActionThen`
|
||||
DoImpulses [ChangeStrategy WatchAndWait]
|
||||
|
||||
retreatAction :: Creature -> Creature -> Action
|
||||
retreatAction tcr cr =
|
||||
chooseMovement' :: Creature -> World -> Action
|
||||
chooseMovement' cr w = takeOneWeighted [chargeProb,retreatProb,strafeProb,strafeProb]
|
||||
[chargeActions
|
||||
,retreatActions ycr cr
|
||||
,strafeLeftActions
|
||||
,strafeRightActions
|
||||
] & evalState $ g
|
||||
where
|
||||
g = _randGen w
|
||||
cpos = _crPos cr
|
||||
ycr = _creatures w IM.! 0
|
||||
ypos = _crPos ycr
|
||||
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 :: Float
|
||||
| otherwise = 0
|
||||
chargeActions =
|
||||
[TurnToward ypos 0.1]
|
||||
`DoImpulsesAlongside`
|
||||
3
|
||||
`DoReplicate`
|
||||
ImpulsesList (replicate 9 [Move (3,0)] ++ [[Move (3,0),UseItem]])
|
||||
strafeLeftActions =
|
||||
DoImpulses [TurnToward yposr (2*pi)]
|
||||
`DoActionThen`
|
||||
3
|
||||
`DoReplicate`
|
||||
ImpulsesList (replicate 9 [Move (0,3)] ++ [[Move (0,3),UseItem]])
|
||||
strafeRightActions =
|
||||
DoImpulses [TurnToward yposl (2*pi)]
|
||||
`DoActionThen`
|
||||
3
|
||||
`DoReplicate`
|
||||
ImpulsesList (replicate 9 [Move (0,-3)] ++ [[Move (0,-3),UseItem]])
|
||||
yposl = ypos -.- 100 *.* (vNormal $ normalizeV $ ypos -.- cpos)
|
||||
yposr = ypos +.+ 100 *.* (vNormal $ normalizeV $ ypos -.- cpos)
|
||||
|
||||
retreatActions :: Creature -> Creature -> Action
|
||||
retreatActions tcr cr =
|
||||
[TurnToward retreatOffset 0.2]
|
||||
`DoImpulsesAlongside`
|
||||
NoAction
|
||||
3
|
||||
`DoReplicate`
|
||||
ImpulsesList (replicate 9 [Move (-3,0)] ++ [[UseItem]])
|
||||
where
|
||||
cpos = _crPos cr
|
||||
tpos = _crPos tcr
|
||||
@@ -70,3 +116,4 @@ retreatAction tcr cr =
|
||||
tpos
|
||||
(tpos +.+ vNormal (cpos -.- tpos))
|
||||
|
||||
|
||||
|
||||
@@ -137,6 +137,9 @@ performAction cr w ac = case ac of
|
||||
(imps, Just ac) -> (imps, Just $ DoActionWhilePartial ac f resetAc)
|
||||
(imps, _) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc)
|
||||
| otherwise -> performAction cr w partAc
|
||||
DoActionIf f ac
|
||||
| f (w,cr) -> performAction cr w ac
|
||||
| otherwise -> ([],Nothing)
|
||||
DoActionIfElse ac f ac'
|
||||
| f (w,cr) -> performAction cr w ac
|
||||
| otherwise -> performAction cr w ac'
|
||||
@@ -164,7 +167,9 @@ performAction cr w ac = case ac of
|
||||
_ -> ([],Nothing)
|
||||
UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
||||
ArbitraryAction f -> performAction cr w (f cr w)
|
||||
DoImpulsesAlongside sideImpulses mainAc -> undefined
|
||||
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
|
||||
(imp, Just ac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp ac)
|
||||
(imp, _) -> (sideImp ++ imp, Nothing)
|
||||
DoReplicate t ac -> performAction cr w $ DoReplicatePartial ac t ac
|
||||
DoReplicatePartial _ 0 ac' -> performAction cr w ac'
|
||||
DoReplicatePartial ac t ac' -> case performAction cr w ac' of
|
||||
|
||||
@@ -0,0 +1,76 @@
|
||||
module Dodge.Creature.SpreadGunCrit
|
||||
( spreadGunCrit
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Default
|
||||
import Dodge.Creature.Picture
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Creature.ActionRat
|
||||
import Dodge.Creature.ChooseTarget
|
||||
import Dodge.Creature.SetTarget
|
||||
import Dodge.Creature.Rationality
|
||||
import Dodge.Creature.AlertLevel
|
||||
import Dodge.Creature.State
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.Item.Weapon
|
||||
import Dodge.Item.Consumable
|
||||
import Geometry
|
||||
import Picture
|
||||
import Dodge.RandomHelp
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
|
||||
|
||||
spreadGunCrit :: Creature
|
||||
spreadGunCrit = defaultCreature
|
||||
{ _crPict = basicCrPict red
|
||||
, _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
|
||||
[ performActions
|
||||
, watchUpdateStrat
|
||||
[ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0)
|
||||
[DoActionIf (not . crIsAiming) DrawWeapon
|
||||
,DoActionThen
|
||||
(DoActionWhile crHasTargetLOS $ ArbitraryAction chooseMovement)
|
||||
(DoImpulses [ChangeStrategy WatchAndWait])
|
||||
]
|
||||
)
|
||||
, (crAwayFromPost, goToPostStrat)
|
||||
]
|
||||
, basicPerceptionUpdate [0]
|
||||
, doStrategyActions
|
||||
, reloadOverride
|
||||
, targetYouWhenCognizant
|
||||
, overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
|
||||
$ \ _ -> crActionPlan . crStrategy .~ WatchAndWait
|
||||
]
|
||||
, _crActionPlan = ActionPlan
|
||||
{ _crImpulse = []
|
||||
, _crAction = []
|
||||
, _crStrategy = StrategyActions WatchAndWait [StartSentinelPost]
|
||||
, _crGoal = []
|
||||
}
|
||||
, _crInv = IM.fromList [(0,spreadGun),(1,medkit 100)]
|
||||
, _crInvSel = 0
|
||||
, _crRad = 10
|
||||
, _crHP = 500
|
||||
}
|
||||
|
||||
chooseMovement :: Creature -> World -> Action
|
||||
chooseMovement cr w
|
||||
| dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi
|
||||
= DoImpulses [UseItem, MoveForward (-3)]
|
||||
| d < 30 = DoImpulses [UseItem,TurnToward p 0.06]
|
||||
| d < 60 = DoImpulses [UseItem,TurnToward p 0.06,MoveForward 3]
|
||||
| d < 100 = DoImpulses [TurnToward p 0.06, MoveForward 3 ]
|
||||
| d < 200 = DoImpulses [TurnToward p (0.06 + 0.002 *(d-100)), MoveForward 3 ]
|
||||
| otherwise
|
||||
= DoImpulses [TurnToward p 0.26, MoveForward 3]
|
||||
where
|
||||
d = dist cpos p
|
||||
cpos = _crPos cr
|
||||
tcr = _creatures w IM.! 0
|
||||
p = _crPos tcr
|
||||
@@ -9,6 +9,7 @@ import Dodge.Creature.Stance.Data
|
||||
import Picture.Data
|
||||
|
||||
import Control.Lens
|
||||
import qualified Data.Set as S
|
||||
|
||||
data CreatureState = CrSt
|
||||
{ _goals :: [[Impulse]]
|
||||
@@ -39,6 +40,10 @@ data Faction
|
||||
| PlayerFaction
|
||||
deriving (Eq,Show)
|
||||
|
||||
data CrGroup
|
||||
= LoneWolf
|
||||
| Swarm { _swarm :: S.Set Int }
|
||||
|
||||
makeLenses ''CreatureState
|
||||
makeLenses ''CrSpState
|
||||
makeLenses ''Impulse
|
||||
|
||||
@@ -0,0 +1,39 @@
|
||||
module Dodge.Creature.SwarmCrit
|
||||
( swarmCrit
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Default
|
||||
import Dodge.Creature.Picture
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Creature.ActionRat
|
||||
import Dodge.Creature.ImpulseRat
|
||||
import Dodge.Creature.ChooseTarget
|
||||
import Dodge.Creature.SetTarget
|
||||
import Dodge.Creature.Rationality
|
||||
import Dodge.Creature.AlertLevel
|
||||
import Dodge.Creature.State
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.Item.Weapon
|
||||
import Dodge.Item.Consumable
|
||||
import Dodge.Picture.Layer
|
||||
import Geometry
|
||||
import Picture
|
||||
import Dodge.RandomHelp
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
|
||||
swarmCrit :: Creature
|
||||
swarmCrit = defaultCreature
|
||||
{ _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
|
||||
, _crHP = 1
|
||||
, _crRad = 4
|
||||
, _crPict = basicCrPict yellow
|
||||
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
||||
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4
|
||||
, _crFaction = ColorFaction yellow
|
||||
}
|
||||
@@ -160,6 +160,7 @@ data Creature = Creature
|
||||
, _crAttentionDir :: AttentionDir
|
||||
, _crAwarenessLevel :: IM.IntMap AwarenessLevel
|
||||
, _crFaction :: Faction
|
||||
, _crGroup :: CrGroup
|
||||
, _crTarget :: Maybe Int
|
||||
}
|
||||
data WorldState
|
||||
@@ -492,6 +493,7 @@ infixr 9 `WaitThen`
|
||||
infixr 9 `DoActionThen`
|
||||
infixr 9 `DoActionWhile`
|
||||
infixr 9 `DoReplicate`
|
||||
infixr 9 `DoImpulsesAlongside`
|
||||
data Action
|
||||
= Attack
|
||||
{_attackTargetID :: Int}
|
||||
@@ -546,6 +548,10 @@ data Action
|
||||
,_doActionWhileCondition :: ( (World, Creature) -> Bool)
|
||||
,_doActionWhileAction :: Action
|
||||
}
|
||||
| DoActionIf
|
||||
{_doActionIfCondition :: ( (World, Creature) -> Bool)
|
||||
,_doActionIfAction :: Action
|
||||
}
|
||||
| DoActionIfElse
|
||||
{_doActionIfElseIfAction :: Action
|
||||
,_doActionIfElseCondition :: ( (World, Creature) -> Bool)
|
||||
|
||||
@@ -98,6 +98,7 @@ defaultCreature = Creature
|
||||
, _crAwarenessLevel = IM.empty
|
||||
, _crFaction = NoFaction
|
||||
, _crTarget = Nothing
|
||||
, _crGroup = LoneWolf
|
||||
}
|
||||
defaultState = CrSt
|
||||
{ _goals = []
|
||||
|
||||
+1
-1
@@ -50,7 +50,7 @@ roomTreex = do
|
||||
[[StartRoom]
|
||||
,[Corridor]
|
||||
,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
|
||||
& rmPS %~ (PS (0,200) 0 (PutCrit launcherCrit) :)
|
||||
& rmPS %~ (PS (0,200) 0 (PutCrit spreadGunCrit) :)
|
||||
]
|
||||
,[Corridor]
|
||||
,[Corridor]
|
||||
|
||||
@@ -38,14 +38,7 @@ import qualified Data.Map as M
|
||||
|
||||
|
||||
placeSpots :: [PlacementSpot] -> World -> World
|
||||
placeSpots pss w = foldr placeSpot w basicPlacements
|
||||
where (collectivePlacements,basicPlacements) = partition typeIsCollective pss
|
||||
typeIsCollective (ps@PS {}) = case _psType ps of CollectivePS {} -> True
|
||||
_ -> False
|
||||
typeIsCollective _ = False
|
||||
|
||||
groupedPlacements = groupBy ((==) `on` _collectiveID . _psType)
|
||||
$ sortBy (compare `on` _collectiveID . _psType) collectivePlacements
|
||||
placeSpots pss w = foldr placeSpot w pss
|
||||
|
||||
placeSpot :: PlacementSpot -> World -> World
|
||||
placeSpot ps w = case ps of
|
||||
|
||||
@@ -25,17 +25,19 @@ data PSType = PutCrit Creature
|
||||
| RandPS (State StdGen PSType)
|
||||
| PutNothing
|
||||
| PutID { _putID :: Int}
|
||||
| CollectivePS
|
||||
{ _collectiveID :: Int
|
||||
, _collectiveNum :: Int
|
||||
, _collectiveFunction :: [Int] -> State StdGen [PSType]
|
||||
}
|
||||
| LabelPS { _psLabel :: Int, _ps :: PSType}
|
||||
data PlacementSpot = PS
|
||||
{ _psPos :: Point2
|
||||
, _psRot :: Float
|
||||
, _psType :: PSType
|
||||
}
|
||||
|
||||
data Placement
|
||||
= SinglePlacement {_placementSpot :: PlacementSpot }
|
||||
| GroupedPlacement
|
||||
{_groupPlacementID :: Int
|
||||
,_groupPlacementFunc :: [PlacementSpot] -> PlacementSpot -> PlacementSpot
|
||||
,_placementSpot :: PlacementSpot
|
||||
}
|
||||
|
||||
makeLenses ''PSType
|
||||
makeLenses ''PlacementSpot
|
||||
makeLenses ''Placement
|
||||
|
||||
Reference in New Issue
Block a user