Cleanup creature update slightly, add show instance for impulses

This commit is contained in:
2022-03-26 08:08:16 +00:00
parent ae7fbe29c2
commit 3698a738f3
17 changed files with 158 additions and 198 deletions
+11 -11
View File
@@ -19,17 +19,17 @@ import Control.Lens
armourChaseCrit :: Creature armourChaseCrit :: Creature
armourChaseCrit = defaultCreature armourChaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR { _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ Left $ watchUpdateStrat [] [ watchUpdateStrat []
, Right doStrategyActions , const doStrategyActions
, Left performActions , performActions
, Left targetYouWhenCognizant , targetYouWhenCognizant
, Left $ setTargetMv (\_ -> _targetCr . _crIntention) , setTargetMv (\_ -> _targetCr . _crIntention)
, Left flockACC , flockACC
, Left $ perceptionUpdate' [0] , perceptionUpdate [0]
, Left goToTarget , goToTarget
, Right overrideMeleeCloseTarget , const overrideMeleeCloseTarget
, Right (crMeleeCooldown %~ max 0 . subtract 1) , const (crMeleeCooldown %~ max 0 . subtract 1)
] ]
, _crHP = 300 , _crHP = 300
, _crPict = basicCrPict green , _crPict = basicCrPict green
+4 -12
View File
@@ -2,18 +2,10 @@ module Dodge.Creature.ChainUpdates where
import Dodge.Data import Dodge.Data
import Data.Foldable import Data.Foldable
chainCreatureUpdatesLR'
:: [Either (World -> Creature -> Creature) (Creature -> Creature)]
-> World -> Creature -> Creature
chainCreatureUpdatesLR' ls w cr = foldr unf cr ls
where
unf (Left g) = g w
unf (Right g) = g
chainCreatureUpdatesLR chainCreatureUpdates
:: [Either (World -> Creature -> Creature) (Creature -> Creature)] :: [World -> Creature -> Creature]
-> World -> Creature -> Creature -> World -> Creature -> Creature
chainCreatureUpdatesLR ls w cr = foldl' unf cr ls chainCreatureUpdates ls w cr = foldl' unf cr ls
where where
unf cr' (Left g) = g w cr' unf cr' g = g w cr'
unf cr' (Right g) = g cr'
+10 -10
View File
@@ -33,16 +33,16 @@ smallChaseCrit = chaseCrit
} }
chaseCrit :: Creature chaseCrit :: Creature
chaseCrit = defaultCreature chaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR { _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ Right doStrategyActions [ const doStrategyActions
, Left performActions , performActions
, Right overrideMeleeCloseTarget , const overrideMeleeCloseTarget
, Right setViewPos , const setViewPos
, Right setMvPos , const setMvPos
, Left goToTarget , goToTarget
, Left $ perceptionUpdate' [0] , perceptionUpdate [0]
, Left targetYouWhenCognizant , targetYouWhenCognizant
, Right (crMeleeCooldown %~ max 0 . subtract 1) , const (crMeleeCooldown %~ max 0 . subtract 1)
] ]
, _crHP = 150 , _crHP = 150
, _crPict = basicCrPict green , _crPict = basicCrPict green
+2 -1
View File
@@ -17,7 +17,8 @@ import System.Random
import Data.Bifunctor import Data.Bifunctor
--import Data.Maybe --import Data.Maybe
impulsiveAI :: (World -> Creature -> Creature) impulsiveAI
:: (World -> Creature -> Creature) -- | internal creature update
-> Creature -> Creature
-> World -> World
-> (World -> World , Creature) -> (World -> World , Creature)
+8 -8
View File
@@ -24,17 +24,17 @@ import Control.Lens
launcherCrit :: Creature launcherCrit :: Creature
launcherCrit = defaultCreature launcherCrit = defaultCreature
{ _crPict = basicCrPict red { _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR , _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ Left performActions [ performActions
, Left $ watchUpdateStrat , watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire]) [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])
, (const crAwayFromPost, const goToPostStrat) , (const crAwayFromPost, const goToPostStrat)
] ]
, Left $ perceptionUpdate' [0] , perceptionUpdate [0]
, Right doStrategyActions , const doStrategyActions
, Right reloadOverride , const reloadOverride
, Left targetYouWhenCognizant , targetYouWhenCognizant
, Right $ overrideInternal , const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait) (crActionPlan . crStrategy .~ WatchAndWait)
] ]
+8 -8
View File
@@ -26,9 +26,9 @@ import Control.Lens
ltAutoCrit :: Creature ltAutoCrit :: Creature
ltAutoCrit = defaultCreature ltAutoCrit = defaultCreature
{ _crPict = basicCrPict red { _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR , _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ Left performActions [ performActions
, Left $ watchUpdateStrat , watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
[DoActionIf (const $ not . crIsAiming) drawWeapon [DoActionIf (const $ not . crIsAiming) drawWeapon
,DoActionThen ,DoActionThen
@@ -38,11 +38,11 @@ ltAutoCrit = defaultCreature
) )
, (const crAwayFromPost, const goToPostStrat) , (const crAwayFromPost, const goToPostStrat)
] ]
, Left $ perceptionUpdate' [0] , perceptionUpdate [0]
, Right doStrategyActions , const doStrategyActions
, Right reloadOverride , const reloadOverride
, Left targetYouWhenCognizant , targetYouWhenCognizant
, Right $ overrideInternal , const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait) (crActionPlan . crStrategy .~ WatchAndWait)
] ]
+8 -64
View File
@@ -1,11 +1,8 @@
--{-# LANGUAGE TupleSections #-} --{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Perception module Dodge.Creature.Perception
( perceptionUpdate ( perceptionUpdate
, perceptionUp
, perceptionUpdate'
, newSounds , newSounds
) ) where
where
import Dodge.Data import Dodge.Data
import Dodge.Creature.Vocalization import Dodge.Creature.Vocalization
import Dodge.Base.Collide import Dodge.Base.Collide
@@ -18,38 +15,20 @@ import Sound.Data
import Data.Maybe import Data.Maybe
import Control.Lens import Control.Lens
import Control.Monad.Reader
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
{- | Ties together (currently) an awareness and attention update -}
perceptionUpdate perceptionUpdate
:: [Int] -- ^ List of creature ids that may direct attention and awareness
-> Creature
-> Reader World Creature
perceptionUpdate is cr = basicAttentionUpdate is cr
>>= basicAwarenessUpdate
>>= rememberSounds
perceptionUpdate'
:: [Int] -- ^ List of creature ids that may direct attention and awareness :: [Int] -- ^ List of creature ids that may direct attention and awareness
-> World -> World
-> Creature -> Creature
-> Creature -> Creature
perceptionUpdate' is w cr = rememberSounds' w $ basicAwarenessUpdate' $ basicAttentionUpdate' is w cr perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
--perceptionUpdate' is w cr = basicAwarenessUpdate' $ basicAttentionUpdate' is w cr
perceptionUp :: Int -> World -> Creature -> Creature
perceptionUp i w cr | canSee i (_crID cr) w = cr & crPerception . crAwarenessLevel . at i ?~ Cognizant 100
| otherwise = cr & crPerception . crAwarenessLevel . at i .~ Nothing
{- | Update a creatures awareness based upon the creatures' current direction {- | Update a creatures awareness based upon the creatures' current direction
of attention -} of attention -}
basicAwarenessUpdate' basicAwarenessUpdate :: Creature -> Creature
:: Creature basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
-> Creature
basicAwarenessUpdate' cr = case _crAttentionDir $ _crPerception cr of
AttentiveTo is -> cr AttentiveTo is -> cr
& crPerception . crAwarenessLevel & crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
@@ -64,25 +43,6 @@ basicAwarenessUpdate' cr = case _crAttentionDir $ _crPerception cr of
| otherwise = id | otherwise = id
Fixated i -> cr & crPerception . crAwarenessLevel Fixated i -> cr & crPerception . crAwarenessLevel
%~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness) %~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
{- | Update a creatures awareness based upon the creatures' current direction
of attention -}
basicAwarenessUpdate
:: Creature -> Reader World Creature
basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
AttentiveTo is -> pure $ cr
& crPerception . crAwarenessLevel
%~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
& maybeBark
where
oldAwareness = _crAwarenessLevel $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
maybeBark | becomesCognizant = case vocalizationTest cr of
Just sid -> crActionPlan . crImpulse .~ [Bark sid]
Nothing -> id
| otherwise = id
Fixated i -> pure $ cr & crPerception . crAwarenessLevel
%~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
cogRaised :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel cogRaised :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel
cogRaised Suspicious{} Cognizant{} = Cognizant 100 cogRaised Suspicious{} Cognizant{} = Cognizant 100
@@ -111,22 +71,11 @@ decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 50
{- | Given a fixed group of creatures, direct attention to those of them that {- | Given a fixed group of creatures, direct attention to those of them that
- are in view. -} - are in view. -}
basicAttentionUpdate basicAttentionUpdate
:: [Int] -- ^ Creatures that may attract this creature's attention
-> Creature
-> Reader World Creature
basicAttentionUpdate cids cr = do
w <- ask
pure $ cr & crPerception . crAttentionDir .~
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
{- | Given a fixed group of creatures, direct attention to those of them that
- are in view. -}
basicAttentionUpdate'
:: [Int] -- ^ Creatures that may attract this creature's attention :: [Int] -- ^ Creatures that may attract this creature's attention
-> World -> World
-> Creature -> Creature
-> Creature -> Creature
basicAttentionUpdate' cids w cr = cr & crPerception . crAttentionDir .~ basicAttentionUpdate cids w cr = cr & crPerception . crAttentionDir .~
AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids) AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
newExtraAwareness newExtraAwareness
@@ -159,14 +108,9 @@ newSounds = mapMaybe f . M.elems . _playingSounds
JustStartedPlaying -> Just (_soundPos s, _soundVolume s) JustStartedPlaying -> Just (_soundPos s, _soundVolume s)
_ -> Nothing _ -> Nothing
rememberSounds :: Creature -> Reader World Creature rememberSounds :: World -> Creature -> Creature
rememberSounds cr = do rememberSounds w cr = cr
sList <- asks newSounds & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w))
return $ cr & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) sList)
-- return $ cr & crMemory . soundsToInvestigate .~ [V2 0 0]
--
rememberSounds' :: World -> Creature -> Creature
rememberSounds' w cr = cr & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w))
soundIsClose :: Creature -> (Point2,Float) -> Bool soundIsClose :: Creature -> (Point2,Float) -> Bool
soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr)) soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr))
+8 -8
View File
@@ -29,18 +29,18 @@ import Control.Monad.State
pistolCrit :: Creature pistolCrit :: Creature
pistolCrit = defaultCreature pistolCrit = defaultCreature
{ _crPict = basicCrPict red { _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR , _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[Left performActions [ performActions
,Left $ watchUpdateStrat , watchUpdateStrat
[ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0)
[DoActionIf (const $ not . crIsAiming) drawWeapon,chooseMovement cr w]) [DoActionIf (const $ not . crIsAiming) drawWeapon,chooseMovement cr w])
, (const crAwayFromPost, const goToPostStrat) , (const crAwayFromPost, const goToPostStrat)
] ]
,Left $ perceptionUpdate' [0] , perceptionUpdate [0]
,Right doStrategyActions , const doStrategyActions
,Right reloadOverride , const reloadOverride
,Left targetYouWhenCognizant , targetYouWhenCognizant
,Right $ overrideInternal , const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait) (crActionPlan . crStrategy .~ WatchAndWait)
] ]
+1 -1
View File
@@ -59,7 +59,7 @@ setTargetMv targFunc w cr = maybe
(\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg) (\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
(targFunc w cr) (targFunc w cr)
-- fugly -- ugly
flockACC :: World -> Creature -> Creature flockACC :: World -> Creature -> Creature
flockACC w cr = case cr ^? crIntention . targetCr . _Just of flockACC w cr = case cr ^? crIntention . targetCr . _Just of
Nothing -> cr Nothing -> cr
+15 -15
View File
@@ -45,9 +45,9 @@ sentinelAI w = reloadOverride .
sentinelFireType :: (Int -> Action) -> World -> Creature -> Creature sentinelFireType :: (Int -> Action) -> World -> Creature -> Creature
sentinelFireType f = chainCreatureUpdatesLR sentinelFireType f = chainCreatureUpdates
[ Left performActions [ performActions
, Left $ watchUpdateStrat , watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
[ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] [ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
, aiming , aiming
@@ -55,12 +55,12 @@ sentinelFireType f = chainCreatureUpdatesLR
) )
, (const crAwayFromPost, const goToPostStrat) , (const crAwayFromPost, const goToPostStrat)
] ]
, Left $ perceptionUpdate' [0] , perceptionUpdate [0]
-- , Left $ perceptionUp 0 -- , Left $ perceptionUp 0
, Right doStrategyActions , const doStrategyActions
, Right reloadOverride , const reloadOverride
, Left targetYouWhenCognizant , targetYouWhenCognizant
, Right $ overrideInternal , const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait) (crActionPlan . crStrategy .~ WatchAndWait)
] ]
@@ -76,14 +76,14 @@ sentinelExtraWatchUpdate
-> World -> World
-> Creature -> Creature
-> Creature -> Creature
sentinelExtraWatchUpdate xs = chainCreatureUpdatesLR sentinelExtraWatchUpdate xs = chainCreatureUpdates
[ Left performActions [ performActions
, Left $ watchUpdateStrat , watchUpdateStrat
( xs ++ [(const crAwayFromPost, const goToPostStrat)] ) ( xs ++ [(const crAwayFromPost, const goToPostStrat)] )
, Left $ perceptionUpdate' [0] , perceptionUpdate [0]
, Right doStrategyActions , const doStrategyActions
, Left targetYouWhenCognizant , targetYouWhenCognizant
, Right $ overrideInternal , const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(crActionPlan . crStrategy .~ WatchAndWait) (crActionPlan . crStrategy .~ WatchAndWait)
] ]
+8 -8
View File
@@ -27,9 +27,9 @@ import Control.Lens
spreadGunCrit :: Creature spreadGunCrit :: Creature
spreadGunCrit = defaultCreature spreadGunCrit = defaultCreature
{ _crPict = basicCrPict red { _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR , _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[Left performActions [performActions
,Left $ watchUpdateStrat ,watchUpdateStrat
[ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0)
[DoActionIf (const $ not . crIsAiming) drawWeapon [DoActionIf (const $ not . crIsAiming) drawWeapon
,DoActionThen ,DoActionThen
@@ -39,11 +39,11 @@ spreadGunCrit = defaultCreature
) )
, (const crAwayFromPost, const goToPostStrat) , (const crAwayFromPost, const goToPostStrat)
] ]
,Left $ perceptionUpdate' [0] ,perceptionUpdate [0]
,Right doStrategyActions ,const doStrategyActions
,Right reloadOverride ,const reloadOverride
,Left targetYouWhenCognizant ,targetYouWhenCognizant
,Right $ overrideInternal ,const $ overrideInternal
(\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr)
(\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait) (\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait)
] ]
+12 -13
View File
@@ -35,8 +35,8 @@ import Control.Monad.State
import System.Random import System.Random
--import qualified Data.Set as S --import qualified Data.Set as S
--import qualified Data.Map as M --import qualified Data.Map as M
import qualified Data.Vector as V --import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV --import qualified Data.Vector.Mutable as MV
-- | The movement is updated before the ai in order to correctly set the oldpos. -- | The movement is updated before the ai in order to correctly set the oldpos.
-- This should be made more sensible: should the movement side effects apply to -- This should be made more sensible: should the movement side effects apply to
@@ -49,14 +49,13 @@ stateUpdate = stateUpdateDamage doDamage
stateUpdateDamage :: (Creature -> World -> World) stateUpdateDamage :: (Creature -> World -> World)
-> (Creature -> World -> (World -> World, Creature)) -> (Creature -> World -> (World -> World, Creature))
-- -> CRUpdate
-> Creature -> World -> World -> Creature -> World -> World
stateUpdateDamage damageupdate u cr w = damageupdate cr $ stateUpdateDamage damageupdate u cr w = damageupdate cr $
mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f $ w invSideEff upcr . movementSideEff cr . deathEff . f $ w
& creatures . at (_crID cr) .~ (stepReloading <$> crOrCorpse upcr) & creatures . at (_crID cr) .~ (mvcrhammerup . stepReloading <$> crOrCorpse upcr)
where where
(f,upcr) = u (updateMovement cr) w (f,upcr) = u (updateMovement cr) w
mvcrhammerup = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp mvcrhammerup = crHammerPosition %~ moveHammerUp
crOrCorpse cr' crOrCorpse cr'
| cr' ^. crHP > 0 = Just cr' | cr' ^. crHP > 0 = Just cr'
| otherwise = Nothing | otherwise = Nothing
@@ -87,18 +86,18 @@ clearDamage cr = creatures . ix (_crID cr) . crState . crDamage .~ []
doDamage :: Creature -> World -> World doDamage :: Creature -> World -> World
doDamage cr w = w doDamage cr w = w
& creatures . ix (_crID cr) . crState . crDamage .~ [] & creatures . ix (_crID cr) . crState . crDamage .~ []
& creatures . ix (_crID cr) . crState . crPastDamage %~ advancePastDamages dams -- & creatures . ix (_crID cr) . crState . crPastDamage %~ advancePastDamages dams
& _crApplyDamage cr dams cr & _crApplyDamage cr dams cr
where where
dams = _crDamage $ _crState cr dams = _crDamage $ _crState cr
advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage] --advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage]
advancePastDamages newDs v = f $ V.backpermute v bpVector --advancePastDamages newDs v = f $ V.backpermute v bpVector
where -- where
f = V.modify $ \v' -> MV.write v' 0 newDs -- f = V.modify $ \v' -> MV.write v' 0 newDs
bpVector :: V.Vector Int --bpVector :: V.Vector Int
bpVector = V.fromList $ 0 : [0 .. 18] --bpVector = V.fromList $ 0 : [0 .. 18]
movementSideEff :: Creature -> World -> World movementSideEff :: Creature -> World -> World
movementSideEff cr w movementSideEff cr w
+6 -6
View File
@@ -18,12 +18,12 @@ import Control.Lens
swarmCrit :: Creature swarmCrit :: Creature
swarmCrit = defaultCreature swarmCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdatesLR { _crUpdate = stateUpdate $ impulsiveAI $ chainCreatureUpdates
[ Left $ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) [ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
, Right (crMeleeCooldown %~ max 0 . subtract 1) , const (crMeleeCooldown %~ max 0 . subtract 1)
, Left $ perceptionUpdate' [0] , perceptionUpdate [0]
, Right doStrategyActions , const doStrategyActions
, Left targetYouWhenCognizant , targetYouWhenCognizant
] ]
-- , doStrategyActions -- , doStrategyActions
-- , targetYouWhenCognizant -- , targetYouWhenCognizant
+30 -6
View File
@@ -44,7 +44,7 @@ import Dodge.GameRoom
import Color import Color
import Shape import Shape
import qualified Data.Vector as V --import qualified Data.Vector as V
import GHC.Generics import GHC.Generics
import Control.Lens import Control.Lens
import Control.Monad.State import Control.Monad.State
@@ -862,10 +862,7 @@ data Impulse
| UseItem | UseItem
| SwitchToItem Int | SwitchToItem Int
| DropItem | DropItem
-- | PickupNearby Int
-- | UseWorldObject Int
| Bark SoundID -- placeholder for various communication types | Bark SoundID -- placeholder for various communication types
-- | UseIntrinsicAbility
| Melee Int | Melee Int
| ChangePosture Posture | ChangePosture Posture
| MakeSound SoundID | MakeSound SoundID
@@ -882,6 +879,30 @@ data Impulse
| ImpulseUseAheadPos | ImpulseUseAheadPos
{_impulseUseAheadPos :: Point2 -> Impulse {_impulseUseAheadPos :: Point2 -> Impulse
} }
instance Show Impulse where
show imp = case imp of
Move p -> "Move "++show p
MoveForward f -> "MoveForward "++ show f
Turn f -> "Turn "++show f
RandomTurn f -> "RandomTurn "++show f
TurnToward p f -> "TurnToward "++show p++show f
MvTurnToward p -> "MvTurnToward "++show p
MvForward -> "MvForward"
TurnTo p -> "TurnTo "++show p
UseItem -> "UseItem"
SwitchToItem i -> "SwitchToItem "++show i
DropItem -> "DropItem"
Bark sid -> "Bark "++show sid
Melee i -> "Melee "++show i
ChangePosture post -> "ChangePosture " ++ show post
MakeSound sid -> "MakeSound " ++ show sid
ChangeStrategy s -> "ChangeStrategy " ++ show s
AddGoal g -> "AddGoal " ++ show g
ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
ArbitraryImpulse {} -> "ArbitraryImpulse"
ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
ImpulseUseTarget {} -> "ImpulseUseTarget"
ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
-- deriving (Eq,Ord,Show) -- deriving (Eq,Ord,Show)
infixr 9 `WaitThen` infixr 9 `WaitThen`
infixr 9 `DoActionThen` infixr 9 `DoActionThen`
@@ -979,6 +1000,8 @@ data Action
,_mainAction :: Action ,_mainAction :: Action
} }
deriving (Generic) deriving (Generic)
instance Show Action where
show _ = "AnAction"
-- deriving (Eq,Ord,Show) -- deriving (Eq,Ord,Show)
data Strategy data Strategy
= Flank Int = Flank Int
@@ -993,12 +1016,13 @@ data Strategy
| Reload | Reload
| Flee | Flee
| MeleeStrike | MeleeStrike
deriving (Generic) deriving (Generic,Show)
-- deriving (Eq,Ord,Show) -- deriving (Eq,Ord,Show)
data Goal data Goal
= LiveLongAndProsper = LiveLongAndProsper
| Kill Int | Kill Int
| SentinelAt Point2 Float | SentinelAt Point2 Float
deriving (Show)
newtype Zone a = Zone newtype Zone a = Zone
{ _znObjects :: IM.IntMap (IM.IntMap a) { _znObjects :: IM.IntMap (IM.IntMap a)
@@ -1037,7 +1061,7 @@ isMovementDam dm = case _dmType dm of
data CreatureState = CrSt data CreatureState = CrSt
{ _crDamage :: [Damage] { _crDamage :: [Damage]
, _crPastDamage :: V.Vector [Damage] -- , _crPastDamage :: V.Vector [Damage]
, _crSpState :: CrSpState , _crSpState :: CrSpState
, _crDropsOnDeath :: CreatureDropType , _crDropsOnDeath :: CreatureDropType
} }
+2 -2
View File
@@ -19,7 +19,7 @@ import Shape
import Control.Lens import Control.Lens
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Vector as V --import qualified Data.Vector as V
--import Data.Monoid --import Data.Monoid
defaultCreature :: Creature defaultCreature :: Creature
defaultCreature = Creature defaultCreature = Creature
@@ -132,7 +132,7 @@ yourDefaultStrideLength = 40
defaultState :: CreatureState defaultState :: CreatureState
defaultState = CrSt defaultState = CrSt
{ _crDamage = [] { _crDamage = []
, _crPastDamage = V.fromList $ replicate 20 [] -- , _crPastDamage = V.fromList $ replicate 20 []
, _crSpState = GenCr , _crSpState = GenCr
, _crDropsOnDeath = DropAll , _crDropsOnDeath = DropAll
} }
+1 -1
View File
@@ -257,7 +257,7 @@ updateArc = createNewArc
shootLaser :: Item -> Creature -> World -> World shootLaser :: Item -> Creature -> World -> World
shootLaser it cr = (instantParticles .:~ lasRayAt phasev pos dir) shootLaser it cr = (instantParticles .:~ lasRayAt phasev pos dir)
. flareCircleAt yellow 0.8 (pos `v2z` 25) . flareCircleAt yellow 0.8 (pos `v2z` 20)
where where
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr dir = _crDir cr