diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 1a6b21cbf..e9c8b3d41 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -430,207 +430,6 @@ chargeAI w (f,g) cr = _ -> ( (f , g') , replaceImpulse [] cr ) (Init:_) -> ((f,g), replaceImpulse [] cr) -launcherAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -launcherAI inRange outRange w (f,g) cr = - let cpos = _crPos cr - cid = _crID cr - ypos = _crPos $ you w - yposl x = ypos -.- x *.* (vNormal $ normalizeV $ ypos -.- cpos) - yposr x = ypos +.+ x *.* (vNormal $ normalizeV $ ypos -.- cpos) - (aimtime,g') = randomR (80,120) g - (recupTime,_) = randomR (0,50) g - wp = _crInv cr IM.! _crInvSel cr - noAmmo = 0 == _wpLoadedAmmo wp || _wpReloadState wp /= 0 - updateSearch = over (crState . goals) f - where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs) - f (g:gs) = (g:[PathTo ypos]:gs) - replaceGoal 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) - ts = take 3 $ randomRs (20,25) g - retreatActions = SetPosture Aiming - : Fire - : TurnByFor 0.16 20 - : SetPosture AtEase - : MoveByFor (3,0) 18 - : SetPosture Aiming - : Fire - : TurnByFor (-0.16) 20 - : SetPosture AtEase - : MoveByFor (3,0) 10 - : TurnToward ypos - -- : WaitFor 12 - -- : Fire - -- : WaitFor 20 - : SetPosture Aiming - : Fire - : WaitFor 60 - : [SetPosture AtEase] - strafeLeftActions = TurnToward (yposr 30) - : SetPosture Aiming - : (concatMap (\t -> [Fire,MoveByFor (0,3) t]) ts) - ++ [SetPosture AtEase] - strafeRightActions = TurnToward (yposl 30) - : SetPosture Aiming - : (concatMap (\t -> [Fire,MoveByFor (0,-3) t]) ts) - ++ [SetPosture AtEase] - rota a = cpos +.+ rotateV a (ypos -.- cpos) - (a2:a3:a4:a5:_) = evalState (takeOne [[0.1,0.15,0.5,1.5] - --,[0.1,0.15,0.5,1.5] - -- ,[0.2,0.3,0.6,1] - -- ,[0.2,0.3,0.5,0.8] - -- ,[0.2,0.3,0.5,1] - -- ,[0.1,0.2,0.5,0.9] - -- ,[0.1,0.2,0.4,0.7] - -- ,[0.1,0.2,0.3,0.4] - ] - ) g - curveLeft = TurnToward (rota $ negate a2) - : SetPosture Aiming - : Fire - : TurnToward (rota $ negate a3) - : WaitFor 20 - : Fire - : TurnToward (rota $ negate a4) - : WaitFor 20 - : Fire - : TurnToward (rota $ negate a5) - : SetPosture AtEase - : [MoveByFor (-3,0) 40] - curveRight = TurnToward (rota a2) - : SetPosture Aiming - : Fire - : TurnToward (rota a3) - : WaitFor 20 - : Fire - : TurnToward (rota a4) - : WaitFor 20 - : Fire - : TurnToward (rota a5) - : SetPosture AtEase - : [MoveByFor (-3,0) 40] - strafeProb :: Float - strafeProb | dist cpos ypos > 350 = 40 - | otherwise = 10 - retreatProb | dist cpos ypos < 100 = 80 - | dist cpos ypos < 200 = 40 - | otherwise = 0 - curveLeftProb = 20 - curveRightProb = 20 - -- | dist cpos ypos < 200 = 1 - -- | otherwise = 0 - fireActions = -- TurnToward ypos : - (evalState (takeOneWeighted - [curveLeftProb,curveRightProb - ,strafeProb,strafeProb,retreatProb] - [curveLeft - ,curveRight - ,strafeLeftActions - ,strafeRightActions - ,retreatActions - ] - ) $ g - ) - in --if _crHP cr <= 0 then killCr w f cr else - case head $ _goals $ _crState cr of - (TurnTo p:_) -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr) - (TurnByFor a 0:_) -> ( (f,g') , replaceImpulse [] . over crDir (+a) $ cr) - (TurnByFor a i:_) -> ( (f,g') , replaceImpulse [TurnByFor a (i-1)] . over crDir (+a) $ cr) - (SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crStance . posture) pture cr) - (MoveByFor p 0:_) -> ((f,g'), replaceImpulse [] . crMvBy p $ cr) - (MoveByFor p i:_) -> ((f,g'), replaceImpulse [MoveByFor p (i-1)] . crMvBy p $ cr) - (Fire:_) | pointHitsWalls cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) - (wallsAlongLine cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) w) - -> ((f,g),replaceImpulse [] cr) - | otherwise -> ((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 (MoveForwardFor (x-1))] - . crMvBy p - $ cr - ) - (TurnToward p:_) - | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2 - -> ( (f,g') - , Just . crTurnTowardSpeed 0.5 p - $ cr - ) - | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2 - -> ( (f,g') - , Just . crTurnTowardSpeed 0.1 p - $ cr - ) - | otherwise - -> ( (f,g') - , replaceImpulse [] - . crTurnTo p - $ cr - ) - [] | noAmmo -> ( (tryUseItem cid . f, g') - , addImpulse [Reload] cr - ) - | canSeeFireVisionAny cid (_yourID w) w - -> ( ( f , g' ) - -- , addImpulse (WaitFor 9:fireActions) - , 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)] 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 ) - | canSeeFireVisionAny cid (_yourID w) w - -> ( (f , g') - , Just $ cr - ) -- no longer chase if see you when reloading - -- $ replaceImpulse [] w - | otherwise -> ( (f , g') , Just cr) - (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w - -> ( ( f , g') - , addGoal [[WaitFor aimtime],[PathTo ypos]] cr - ) - | dist cpos p > 10 - -> ( (f,g') , addGoal [[PathTo p]] cr) - | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 - -> ( (f,g') - ,Just $ crTurnTowardSpeed 0.05 p' cr) - | otherwise -> ( (f,g') ,Just cr) - (Init :_) -> ( (f,g') - ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr - ) dodgeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) dodgeAI inRange outRange w (f,g) cr = let cpos = _crPos cr diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 31d42a547..2144af901 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -1,6 +1,7 @@ module Dodge.Creature ( module Dodge.Creature , module Dodge.Creature.Inanimate + , launcherCrit ) where import Dodge.Creature.Stance.Data @@ -12,6 +13,7 @@ import Dodge.Creature.Rationality.Data import Dodge.Creature.AlertLevel import Dodge.Creature.SetTarget import Dodge.Creature.Test +import Dodge.Creature.LauncherCrit import Dodge.Data import Dodge.AIs import Dodge.Default @@ -167,16 +169,6 @@ multGunCrit = defaultCreature , _crGoal = [] } } -launcherCrit :: Creature -launcherCrit = defaultCreature - { _crPict = basicCrPict red - , _crUpdate = stateUpdate (launcherAI 150 200) - , _crInv = IM.fromList [(0,launcher)] - , _crInvSel = 0 - , _crRad = 10 - , _crState = defaultState {_goals = [[Init]]} - , _crHP = 300 - } spreadGunCrit :: Creature spreadGunCrit = defaultCreature { _crPict = basicCrPict red diff --git a/src/Dodge/Creature/ActionRat.hs b/src/Dodge/Creature/ActionRat.hs index c46fa84d9..1b16ae229 100644 --- a/src/Dodge/Creature/ActionRat.hs +++ b/src/Dodge/Creature/ActionRat.hs @@ -9,6 +9,7 @@ module Dodge.Creature.ActionRat , reloadOverride , reloadOverrideNoHolster , shootAdvanceStrat + , shootMoveStrat , watchUpdateStrat , goToPostStrat , overrideInternal @@ -110,6 +111,26 @@ aimThenShootStrat tcid _ _ = StrategyActions (ShootAt tcid) lostest (w,cr') = canSee (_crID cr') tcid w advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] +shootMoveStrat :: Point2 -> Int -> World -> Creature -> Strategy +shootMoveStrat moveV tcid _ _ = StrategyActions (ShootAt tcid) + [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) + `DoActionThen` + (DoActionWhileThen advanceShoot lostest + . DoReplicateThen advanceShoot 75 + $ DoImpulses [ChangeStrategy WatchAndWait] + ) + , AimAtCloseSlow + { _targetID = tcid + , _targetSeenAt = (0,0) -- hack + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + ] + where + lostest (w,cr') = canSee (_crID cr') tcid w + advanceShoot = ImpulsesList [[UseItem, Move moveV]] + shootAdvanceStrat :: Int -> World -> Creature -> Strategy shootAdvanceStrat tcid _ _ = StrategyActions (ShootAt tcid) [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index e74d48aa2..4dca5f528 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -38,20 +38,7 @@ initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLam addLS = over lightSources (IM.insert i (lightAt (_crPos cr) i)) updateLamp :: Int -> CRUpdate -updateLamp i w (f,g) cr = ((handleLS . f, g), internalUpdate) - where - handleLS w' - | _crHP cr < 0 = explosionFlashAt cPos - $ mkSoundBreakGlass cPos w' & lightSources %~ IM.delete i - | otherwise = w' & lightSources . ix i . lsPos .~ cPos - where - cPos = _crPos cr - internalUpdate - | _crHP cr < 0 = Nothing - | otherwise = fmap doDamage $ Just cr - -updateLamp' :: Int -> CRUpdate -updateLamp' i = unrandUpdate handleLS internalUpdate +updateLamp i = unrandUpdate handleLS internalUpdate where handleLS cr w | _crHP cr < 0 = explosionFlashAt cPos @@ -63,7 +50,6 @@ updateLamp' i = unrandUpdate handleLS internalUpdate | _crHP cr < 0 = Nothing | otherwise = Just $ doDamage cr - barrel :: Creature barrel = defaultInanimate { _crUpdate = updateBarrel diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs new file mode 100644 index 000000000..7fd8396ec --- /dev/null +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -0,0 +1,82 @@ +module Dodge.Creature.LauncherCrit + ( launcherCrit + ) + 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 qualified Data.IntMap.Strict as IM +import Control.Lens + +launcherCrit :: Creature +launcherCrit = defaultCreature + { _crPict = basicCrPict red + , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs + [ performActions + , watchUpdateStrat +-- [ (crHasTargetLOS, shootMoveStrat (0,3) 0) + [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire]) + , (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,launcher)] + , _crInvSel = 0 + , _crRad = 10 + , _crState = defaultState + , _crHP = 300 + } + +retreatFire :: Action +retreatFire = ImpulsesList ( [ [ UseItem ] ] ++ replicate 20 [ Turn 0.16 ]) + `DoActionThen` + HolsterWeapon + `DoActionThen` + ImpulsesList ( replicate 30 [ MoveForward 3 ]) + `DoActionThen` + DrawWeapon + `DoActionThen` + ImpulsesList ( [[UseItem]] ++ replicate 20 [ Turn $ negate 0.16 ] ) + `DoActionThen` + HolsterWeapon + `DoActionThen` + ImpulsesList ( replicate 15 [ MoveForward 3 ] ) + `DoActionThen` + DrawWeapon + `DoActionThen` + ImpulsesList ( + replicate 100 [UseItem, ImpulseUseTarget $ \tcr -> TurnToward (_crPos tcr) (pi/16) ] ) + `DoActionThen` + 20 + `WaitThen` + HolsterWeapon + `DoActionThen` + ImpulsesList ( replicate 15 [ MoveForward 3 ] ) + `DoActionThen` + DoImpulses [ChangeStrategy WatchAndWait] + + diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 46f2eda92..5aaf78796 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -40,18 +40,18 @@ followImpulses followImpulses w (f,g) cr = (\(f''' ,cr) -> ((f''',g'),Just cr)) $ foldr - (\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr'')) + (\imp (f' , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f', cr'')) (f, cr) (_crImpulse $ _crActionPlan cr) where g' = snd $ next g followImpulse - :: Impulse + :: Creature -> World - -> Creature + -> Impulse -> (World -> World , Creature) -followImpulse imp w cr = case imp of +followImpulse cr w imp = case imp of Move p -> (id, crMvBy p cr) MoveForward x -> (id, crMvForward x cr) Turn a -> (id, creatureTurn a cr) @@ -69,6 +69,13 @@ followImpulse imp w cr = case imp of ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat) AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) ) ArbitraryCreatureImpulse f -> (id, f w cr) + ImpulseUseTargetCID f -> case cr ^? crTarget . _Just of + Just tcid -> followImpulse cr w (f tcid) + _ -> (id,cr) + ImpulseUseTarget f -> case cr ^? crTarget . _Just of + Just tcid -> followImpulse cr w (f $ _creatures w IM.! tcid) + _ -> (id,cr) + ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) _ -> (id , cr) where cpos = _crPos cr @@ -153,6 +160,7 @@ performAction cr w ac = case ac of UseTargetCID f -> case cr ^? crTarget . _Just of Just tcid -> performAction cr w (f tcid) _ -> ([],Nothing) + UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) _ -> ([], Nothing) where cpos = _crPos cr diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 8e1b9b4ab..4be7db2f9 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -86,7 +86,7 @@ velocity to carry across frames. crFriction :: Creature -> Point2 -> Point2 crFriction cr vel = (0,0) -{- | In order to force a list, apply with seq -} +{- | In order to force a list, apply with seq. -} forceSpine :: [a] -> () forceSpine = foldr (const id) () diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7fcc52c40..e356ba123 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -477,6 +477,15 @@ data Impulse | ChangeStrategy Strategy | AddGoal Goal | ArbitraryCreatureImpulse (World -> Creature -> Creature) + | ImpulseUseTargetCID + {_impulseUseTargetCID :: Int -> Impulse + } + | ImpulseUseTarget + {_impulseUseTarget :: Creature -> Impulse + } + | ImpulseUseAheadPos + {_impulseUseAheadPos :: Point2 -> Impulse + } -- deriving (Eq,Ord,Show) infixr 9 `WaitThen` infixr 9 `DoActionThen` @@ -565,6 +574,9 @@ data Action | UseTargetCID {_useTargetCID :: Int -> Action } + | UseAheadPos + {_useAheadPos :: Point2 -> Action + } deriving (Generic) -- deriving (Eq,Ord,Show) data Strategy diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index a264bded2..5b9e5056e 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,-300) 0 (PutCrit multGunCrit) :) + & rmPS %~ (PS (0,200) 0 (PutCrit launcherCrit) :) ] ,[Corridor] ,[Corridor] diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index ba2cb77a2..663365fa6 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -711,7 +711,7 @@ moveShell time i cid rot accel w hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) thingHit = hitCr <|> hitWl spin = case w ^? creatures . ix cid of - Just cr -> min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 + Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 _ -> 0 r1 = randInCirc 10 & evalState $ _randGen w smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))