From 0b26761be5b3a4b6bb48e80629ad847d930f8ebd Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 14 May 2021 12:04:12 +0200 Subject: [PATCH] AI refactor --- src/Dodge/AIs.hs | 721 +--------------------------- src/Dodge/Base.hs | 2 + src/Dodge/Creature.hs | 26 +- src/Dodge/Creature/LtAutoCrit.hs | 75 +++ src/Dodge/Creature/PistolCrit.hs | 59 ++- src/Dodge/Creature/Rationality.hs | 7 +- src/Dodge/Creature/SpreadGunCrit.hs | 76 +++ src/Dodge/Creature/State/Data.hs | 5 + src/Dodge/Creature/SwarmCrit.hs | 39 ++ src/Dodge/Data.hs | 6 + src/Dodge/Default.hs | 1 + src/Dodge/Floor.hs | 2 +- src/Dodge/LevelGen.hs | 9 +- src/Dodge/LevelGen/Data.hs | 16 +- 14 files changed, 282 insertions(+), 762 deletions(-) create mode 100644 src/Dodge/Creature/LtAutoCrit.hs create mode 100644 src/Dodge/Creature/SpreadGunCrit.hs create mode 100644 src/Dodge/Creature/SwarmCrit.hs diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 62d06fb6f..907a22728 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -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) diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 486640ea2..53b77e146 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -506,3 +506,5 @@ isAnimate :: Creature -> Bool isAnimate cr = case _crActionPlan cr of Inanimate -> False _ -> True + +sigmoid x = x/sqrt(1+x^2) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 78c2252e6..2b81494ae 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -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 diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs new file mode 100644 index 000000000..17782a3f6 --- /dev/null +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -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)) diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 8413912dc..48ad4ad64 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -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)) + diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 481b96f5a..99c5ed3d9 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -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 diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs new file mode 100644 index 000000000..1a58495c1 --- /dev/null +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -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 diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index 91916cf7e..00055afc5 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -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 diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs new file mode 100644 index 000000000..a4ea506cc --- /dev/null +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -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 + } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index a7aece6ad..247d15f32 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index e79fb519e..420a6a1bf 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -98,6 +98,7 @@ defaultCreature = Creature , _crAwarenessLevel = IM.empty , _crFaction = NoFaction , _crTarget = Nothing + , _crGroup = LoneWolf } defaultState = CrSt { _goals = [] diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 5b9e5056e..0f0645d21 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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] diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index bdcc261f1..3f290528b 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -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 diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 66e2ae2d6..34a2ab16c 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -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