diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 51900782f..7d8e202c9 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -11,7 +11,6 @@ module Dodge.Creature , smallChaseCrit ) where -import Dodge.RemoveCreatureEndo import Dodge.Creature.State.Data --import Dodge.Item.Weapon.Grenade import Dodge.Item.Weapon.Booster @@ -70,7 +69,7 @@ spawnerCrit = defaultCreature miniGunCrit :: Creature miniGunCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ + , _crUpdate = stateUpdate $ impulsiveAI $ sentinelFireType (const shootTillEmpty) , _crActionPlan = ActionPlan { _crImpulse = [] @@ -78,7 +77,9 @@ miniGunCrit = defaultCreature , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] , _crGoal = [] } - , _crInv = IM.fromList [(0,miniGun)] + , _crInv = IM.fromList [(0,autoRifle & itConsumption . ammoLoaded .~ 1000)] +-- , _crInv = IM.fromList [(0,miniGun')] +-- , _crInv = IM.fromList [(0,autoRifle)] , _crInvSel = 0 , _crRad = 10 , _crState = defaultState @@ -89,7 +90,7 @@ longCrit :: Creature longCrit = defaultCreature { _crPict = basicCrPict red -- , _crUpdate = stateUpdate sniperAI - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ sentinelFireType $ const shootTillEmpty + , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelFireTypeR $ const shootTillEmpty , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] @@ -109,7 +110,7 @@ multGunCrit = defaultCreature , _crInvSel = 0 , _crRad = 10 , _crHP = 300 - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ sentinelExtraWatchUpdate + , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelExtraWatchUpdate [ ( not . crHasAmmo , \_ _ -> StrategyActions Reload reloadActions ) @@ -150,7 +151,7 @@ startCr = defaultCreature , _crMvDir = pi/2 , _crID = 0 , _crPict = basicCrPict black - , _crUpdate = toCrUpdate $ stateUpdate yourControl + , _crUpdate = stateUpdate yourControl , _crRad = 10 , _crMass = 10 , _crHP = 1000 diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index d4a7388b3..d12b7a762 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -3,6 +3,7 @@ -} module Dodge.Creature.Action ( performActionsR + , performActions , stripNoItems , setMinInvSize , dropUnselected @@ -91,11 +92,7 @@ performTurnToA cr p {- | Performing an action means that a creature has some impulses for a frame, and updates or deletes the action itself. -- doAction -} -performAction - :: Creature - -> World - -> Action - -> OutAction +performAction :: Creature -> World -> Action -> OutAction performAction cr w ac = case ac of AimAt tcid p -> performAimAt cr w tcid p WaitThen 0 newAc -> ([] , Just newAc) diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 0fb451262..e407fe845 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -2,7 +2,6 @@ module Dodge.Creature.ArmourChase ( armourChaseCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.State import Dodge.Creature.ReaderUpdate @@ -20,7 +19,7 @@ import Control.Monad.Reader armourChaseCrit :: Creature armourChaseCrit = defaultCreature - { _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ + { _crUpdate = stateUpdate $ impulsiveAIR $ watchUpdateStratR [] >=> doStrategyActionsR >=> performActionsR >=> diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index 951e257ed..a6168ec36 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -2,7 +2,6 @@ module Dodge.Creature.AutoCrit ( autoCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.SentinelAI @@ -22,7 +21,7 @@ import qualified Data.IntMap.Strict as IM autoCrit :: Creature autoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR sentinelAI + , _crUpdate = stateUpdate $ impulsiveAIR sentinelAI , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 6e30aa8ab..1e57973e3 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -3,7 +3,6 @@ module Dodge.Creature.ChaseCrit ,chaseCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.ReaderUpdate @@ -34,7 +33,7 @@ smallChaseCrit = chaseCrit } chaseCrit :: Creature chaseCrit = defaultCreature - { _crUpdate = toCrUpdate $ stateUpdate $ --dummyUpdate + { _crUpdate = stateUpdate $ --dummyUpdate impulsiveAIR $ doStrategyActionsR >=> performActionsR >=> diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 4bf779d2e..e8148ae61 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -1,7 +1,7 @@ module Dodge.Creature.Impulse ( impulsiveAIR - ) - where + , impulsiveAI + ) where import Dodge.Data import Dodge.Creature.Vocalization import Dodge.Creature.Impulse.Movement @@ -13,15 +13,20 @@ import qualified Data.IntMap.Strict as IM import System.Random import Control.Lens import Control.Monad.Reader -import Data.Monoid import Data.Bifunctor impulsiveAIR :: (Creature -> Reader World Creature) -> Creature -> World - -> (Endo World , Maybe Creature) -impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr + -> (World -> World , Maybe Creature) +impulsiveAIR impf cr w = bimap id Just $ followImpulses w . ($ w) . runReader $ impf cr + +impulsiveAI :: (World -> Creature -> Creature) + -> Creature + -> World + -> (World -> World , Maybe Creature) +impulsiveAI impf cr w = bimap id Just $ followImpulses w $ impf w cr followImpulses :: World diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 93d77d077..2353f57aa 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -3,13 +3,12 @@ Inanimate objects such as lamps, barrels, etc -} module Dodge.Creature.Inanimate - ( lamp - , colorLamp - , barrel + ( barrel , explosiveBarrel + , module Dodge.Creature.Lamp ) where import Dodge.Data -import Dodge.RemoveCreatureEndo +import Dodge.Creature.Lamp import Dodge.WorldEvent.Explosion import Dodge.Creature.Picture --import Dodge.Creature.Stance.Data @@ -17,100 +16,21 @@ import Dodge.Picture.Layer import Dodge.Particle.Spark import Dodge.Default import Dodge.Creature.State -import Dodge.LightSource -import Dodge.WorldEvent.Flash -import Dodge.WorldEvent.Sound -import Dodge.Creature.Update import Picture import qualified IntMapHelp as IM import Geometry --import Geometry.Data --import Geometry.Vector3D -import Polyhedra import Shape import Dodge.SoundLogic import System.Random import Data.List import Control.Lens -import Data.Monoid - -defaultInanimate :: Creature -defaultInanimate = defaultCreature & crActionPlan .~ Inanimate - -colorLamp - :: Point3 -- color of lamp - -> Float -- height of lamp - -> Creature -colorLamp col h = defaultInanimate - { _crUpdate = toCrUpdate $ initialiseColorLamp col h - , _crHP = 100 - , _crPict = picAtCrPosNoRot (lampCrPic h) - , _crRad = 3 - , _crMass = 3 - } - -lamp :: Float -> Creature -lamp h = defaultInanimate - { _crUpdate = toCrUpdate $ initialiseLamp h - , _crHP = 100 - , _crPict = picAtCrPosNoRot (lampCrPic h) - , _crRad = 3 - , _crMass = 3 - } --- it is not clear that any of the attempts with Foldl help at all here -lampCrPic :: Float -> Picture -lampCrPic h = pictures - [ setLayer 1 (setDepth h . color white $ circleSolid 3) - , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1) - ] - where - f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum - ---lTriFold :: a -> a -> L.Fold a [a] ---lTriFold s x = L.Fold (f s) (x,[]) snd --- where --- f s' (x1,l) x2 = (x2,s':x1:x2:l) --- ---preTriFold :: (a -> b) -> [a] -> [b] ---preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs ---preTriFold _ _ = [] --- ---polyToTriFold :: [a] -> [a] ---polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs ---polyToTriFold _ = [] - -initialiseLamp :: Float -> CRUpdate -initialiseLamp = initialiseColorLamp 0.75 - -initialiseColorLamp :: Point3 -> Float -> CRUpdate -initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ toCrUpdate (updateLamp h i)) - where - i = _crID cr - addLS w = w - & lightSources %~ IM.insert lsid (lsColPosID col (V3 x y h) lsid) - & creatures . ix i . crUpdate .~ toCrUpdate (updateLamp h lsid) - where - lsid = IM.newKey $ _lightSources w - (V2 x y) = _crPos cr - -updateLamp :: Float -> Int -> CRUpdate -updateLamp h i = unrandUpdate handleLS internalUpdate - where - handleLS cr w - | _crHP cr < 0 = explosionFlashAt cPos - $ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i - | otherwise = w & lightSources . ix i . lsParam . lsPos .~ f cPos - where - cPos = _crPos cr - f (V2 x y) = V3 x y h - internalUpdate cr - | _crHP cr < 0 = Nothing - | otherwise = Just $ doDamage cr barrel :: Creature barrel = defaultInanimate - { _crUpdate = toCrUpdate updateBarrel + { _crUpdate = updateBarrel , _crHP = 500 , _crPict = picAtCrPos $ onLayer CrLayer $ pictures [ color orange $ circleSolid 10 @@ -125,7 +45,7 @@ barrel = defaultInanimate explosiveBarrel :: Creature explosiveBarrel = defaultInanimate - { _crUpdate = toCrUpdate updateExpBarrel + { _crUpdate = updateExpBarrel , _crHP = 400 , _crPict = shapeAtCrPos . colorSH orange @@ -137,24 +57,16 @@ explosiveBarrel = defaultInanimate , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] ,_crApplyDamage = \_ c -> (id, c) } -updateBarrel - :: Creature - -> World - -> (Endo World, Maybe Creature) -updateBarrel cr _ - | _crHP cr > 0 = (Endo id, newCr) - | otherwise = (Endo id, Nothing) - where - newCr = Just $ doDamage cr +updateBarrel :: Creature -> World -> World +updateBarrel cr + | _crHP cr > 0 = creatures . ix (_crID cr) %~ doDamage + | otherwise = creatures . at (_crID cr) .~ Nothing -- should generate the sparks externally using new random generators -updateExpBarrel - :: Creature - -> World - -> (Endo World, Maybe Creature) +updateExpBarrel :: Creature -> World -> World updateExpBarrel cr w - | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr) - | otherwise = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing) + | _crHP cr > 0 = foldr (.) id pierceSparks $ hiss w & creatures . at (_crID cr) .~ newCr + | otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & creatures . at (_crID cr) .~ Nothing where g = _randGen w damages = _crDamage $ _crState cr @@ -166,12 +78,7 @@ updateExpBarrel cr w colids = randomRs (0,11) g times = randomRs (2,5) g poss = _piercedPoints $ _crSpState $ _crState cr - --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr - --perforate :: DamageType -> Creature -> Creature - --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints) - -- ((:) $ int -.- _crPos cr) cr - --perforate _ cr = cr applyFuseDamage cr' = cr' & crHP %~ subtract (length . _piercedPoints . _crSpState $ _crState cr') hiss | null poss = id diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 321986350..a7058e92e 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -3,7 +3,6 @@ module Dodge.Creature.LauncherCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test @@ -25,7 +24,7 @@ import Control.Monad.Reader launcherCrit :: Creature launcherCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ + , _crUpdate = stateUpdate $ impulsiveAIR $ performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire]) diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index acceba118..c92945de9 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -2,7 +2,6 @@ module Dodge.Creature.LtAutoCrit ( ltAutoCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Impulse @@ -30,7 +29,7 @@ import Control.Monad.Reader ltAutoCrit :: Creature ltAutoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ + , _crUpdate = stateUpdate $ impulsiveAIR $ performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 415b1f750..d261e269b 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -1,6 +1,7 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Creature.Perception ( perceptionUpdate + , perceptionUpdate' , newSounds ) where @@ -29,6 +30,33 @@ perceptionUpdate is cr = basicAttentionUpdate is cr >>= basicAwarenessUpdate >>= rememberSounds +perceptionUpdate' + :: [Int] -- ^ List of creature ids that may direct attention and awareness + -> World + -> Creature + -> Creature +perceptionUpdate' is w cr = rememberSounds' w $ basicAwarenessUpdate' $ basicAttentionUpdate' is w cr + +{- | Update a creatures awareness based upon the creatures' current direction + of attention -} +basicAwarenessUpdate' + :: Creature + -> Creature +basicAwarenessUpdate' cr = case _crAttentionDir $ _crPerception cr of + AttentiveTo is -> 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 -> cr & crPerception . crAwarenessLevel + %~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness) {- | Update a creatures awareness based upon the creatures' current direction of attention -} basicAwarenessUpdate @@ -84,6 +112,16 @@ basicAttentionUpdate cids cr = do 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 + -> World + -> Creature + -> Creature +basicAttentionUpdate' cids w cr = cr & crPerception . crAttentionDir .~ + AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids) + newExtraAwareness :: Creature -- ^ source creature -> World @@ -119,6 +157,9 @@ rememberSounds cr = do sList <- asks newSounds 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 cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr)) diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index a0bfa5c40..9f5fefbcb 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -2,7 +2,6 @@ module Dodge.Creature.PistolCrit ( pistolCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test @@ -30,7 +29,7 @@ import Control.Monad.State pistolCrit :: Creature pistolCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ + , _crUpdate = stateUpdate $ impulsiveAIR $ performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 1c65ce19f..b70c15528 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -1,12 +1,17 @@ {- | Functions updating a creature in a Reader World environment -} module Dodge.Creature.ReaderUpdate ( doStrategyActionsR + , doStrategyActions , setTargetMv , targetYouWhenCognizantR + , targetYouWhenCognizant , overrideMeleeCloseTargetR , watchUpdateStratR + , watchUpdateStrat , reloadOverrideR + , reloadOverride , overrideInternalRRR + , overrideInternal , goToTarget , flockACCR , setMvPos @@ -110,17 +115,31 @@ replaceNullWith :: a -> [a] -> [a] replaceNullWith x [] = [x] replaceNullWith _ xs = xs -doStrategyActionsR - :: Creature - -> Reader World Creature +doStrategyActionsR :: Creature -> Reader World Creature doStrategyActionsR cr = return $ case cr ^? crActionPlan . crStrategy of Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs & crActionPlan . crStrategy .~ strat _ -> cr -reloadOverrideR - :: Creature - -> Reader World Creature +doStrategyActions :: World -> Creature -> Creature +doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of + Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs + & crActionPlan . crStrategy .~ strat + _ -> cr + +reloadOverride :: World -> Creature -> Creature +reloadOverride w cr + | cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded == Just 0 + && cr ^. crStance . posture == Aiming + = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions + | otherwise = cr + where + reloadActions = + [ holsterWeapon + , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) + ] + +reloadOverrideR :: Creature -> Reader World Creature reloadOverrideR cr | cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded == Just 0 && cr ^. crStance . posture == Aiming @@ -141,6 +160,16 @@ overrideInternalRRR test update cr = do b <- test cr if b then update cr else pure cr +overrideInternal + :: (Creature -> Bool) + -> (Creature -> Creature) + -> World + -> Creature + -> Creature +overrideInternal test update w cr + | test cr = update cr + | otherwise = cr + watchUpdateStratR :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] -> Creature @@ -150,6 +179,16 @@ watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr _ -> cr +watchUpdateStrat + :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] + -> World + -> Creature + -> Creature +watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of + Just WatchAndWait -> cr + & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr + _ -> cr + listGuard :: ([(a -> Bool, b)] , b) -> a -> b listGuard ( (test,y):ps, z ) x | test x = y @@ -160,3 +199,8 @@ targetYouWhenCognizantR :: Creature -> Reader World Creature targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0 _ -> cr & crIntention . targetCr .~ Nothing + +targetYouWhenCognizant :: World -> Creature -> Creature +targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of + Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0 + _ -> cr & crIntention . targetCr .~ Nothing diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index a4114d32e..ce32608b3 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -1,6 +1,7 @@ module Dodge.Creature.SentinelAI ( sentinelAI , sentinelFireType + , sentinelFireTypeR , sentinelExtraWatchUpdate ) where import Dodge.Data @@ -40,11 +41,40 @@ sentinelAI = sentinelExtraWatchUpdate tcid cr = _crID <$> _targetCr (_crIntention cr) lostest (w,cr) = maybe False (\cid -> canSee (_crID cr) cid w) (tcid cr) -sentinelFireType +chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature +chainCreatureUpdates ls w cr = foldr (\f -> f w) cr ls + +sentinelFireType :: (Int -> Action) -> World -> Creature -> Creature +sentinelFireType f = chainCreatureUpdates + [ performActions + , watchUpdateStrat + [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) + [ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] + , aiming + ] + ) + , (crAwayFromPost, goToPostStrat) + ] + , perceptionUpdate' [0] + , doStrategyActions + , reloadOverride + , targetYouWhenCognizant + , overrideInternal + (\cr -> crHasTarget' cr && crStratConMatches' (GetTo (V2 0 0)) cr) + ((crActionPlan . crStrategy .~ WatchAndWait)) + ] + where + drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + aiming = AimAt + { _targetID = 0 + , _targetSeenAt = V2 0 0 -- hack + } + +sentinelFireTypeR :: (Int -> Action) -> Creature -> Reader World Creature -sentinelFireType f = performActionsR +sentinelFireTypeR f = performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 16151378c..2d00e52e3 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -2,7 +2,6 @@ module Dodge.Creature.SpreadGunCrit ( spreadGunCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test @@ -31,7 +30,7 @@ import Control.Monad spreadGunCrit :: Creature spreadGunCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ + , _crUpdate = stateUpdate $ impulsiveAIR $ performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 6e7a83b5f..ec622e96f 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -33,7 +33,6 @@ import Control.Monad.State import System.Random --import qualified Data.Set as S --import qualified Data.Map as M -import Data.Monoid import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV @@ -42,13 +41,14 @@ import qualified Data.Vector.Mutable as MV -- the creature before or after it has moved? -- currently invSideEffects are applied after the creature moves, to correctly -- update shield positions -stateUpdate :: CRUpdate -> CRUpdate -stateUpdate = stateUpdateDamage doDamage +stateUpdate :: CRUpdate -> Creature -> World -> World +stateUpdate f cr w = let (fw,mcr) = stateUpdateDamage doDamage f cr w + in fw $ w & creatures . at (_crID cr) .~ mcr stateUpdateDamage :: (Creature -> Creature) -> CRUpdate -> CRUpdate stateUpdateDamage damageupdate u cr w = case u (updateMovement cr) w of (f, maybeCr) -> - ( Endo $ invSideEff (fromMaybe cr maybeCr) . movementSideEff cr . deathEff . appEndo f + ( invSideEff (fromMaybe cr maybeCr) . movementSideEff cr . deathEff . f , fmap (stepReloading . damageupdate) $ crOrCorpse =<< maybeCr ) where diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index 5c8c10c61..421c2c912 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -3,7 +3,6 @@ module Dodge.Creature.SwarmCrit ) where import Dodge.Data -import Dodge.RemoveCreatureEndo import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Boid @@ -19,7 +18,7 @@ import Control.Monad.Reader swarmCrit :: Creature swarmCrit = defaultCreature - { _crUpdate = toCrUpdate $ stateUpdate $ impulsiveAIR $ + { _crUpdate = stateUpdate $ impulsiveAIR $ flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) >=> return . (crMeleeCooldown %~ max 0 . subtract 1) >=> perceptionUpdate [0] diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 12ac0e7b1..d1c94db21 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -68,6 +68,9 @@ crIsAimingR cr = return $ _posture (_crStance cr) == Aiming crHasTarget :: (World,Creature) -> Bool crHasTarget (_,cr) = isJust $ cr ^? crIntention . targetCr . _Just +crHasTarget' :: Creature -> Bool +crHasTarget' cr = isJust $ cr ^? crIntention . targetCr . _Just + crHasTargetR :: Creature -> Reader World Bool crHasTargetR cr = return $ isJust $ cr ^? crIntention . targetCr . _Just @@ -94,6 +97,9 @@ crSafeDistFromTargR d cr = return $ case cr ^? crIntention . targetCr . _Just of crStratConMatches :: Strategy -> (World,Creature) -> Bool crStratConMatches strat (_,cr) = eqConstr strat (_crStrategy $ _crActionPlan cr) +crStratConMatches' :: Strategy -> Creature -> Bool +crStratConMatches' strat cr = eqConstr strat (_crStrategy $ _crActionPlan cr) + crStratConMatchesR :: Strategy -> Creature -> Reader World Bool crStratConMatchesR strat cr = return $ eqConstr strat (_crStrategy $ _crActionPlan cr) diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 67f2ce791..e54284e15 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -3,11 +3,10 @@ module Dodge.Creature.Update ) where import Dodge.Data -import Data.Monoid unrandUpdate :: (Creature -> World -> World) -> (Creature -> Maybe Creature) -> CRUpdate {-# INLINE unrandUpdate #-} -unrandUpdate h cF cr _ = ( Endo (h cr) , cF cr ) +unrandUpdate h cF cr _ = ( (h cr) , cF cr ) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index e0cf67f76..356f6518b 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -11,19 +11,19 @@ import Control.Lens import qualified SDL import qualified Data.Set as S import qualified Data.IntMap.Strict as IM -import Data.Monoid import Data.Maybe {- | The AI equivalent for your control. -} yourControl :: Creature -> World - -> (Endo World, Maybe Creature) + -> (World -> World, Maybe Creature) yourControl cr w = - ( Endo updateUsingInput + ( updateUsingInput , Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr ) where speed = _mvSpeed $ _crMvType cr + {- | Turn key presses into creature movement. -} wasdWithAiming :: World diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 60594adbc..610eb7b62 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -52,8 +52,7 @@ import qualified Data.IntSet as IS import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M import SDL (Scancode, MouseButton) -import Data.Monoid -type CRUpdate = Creature -> World -> (Endo World, Maybe Creature) +type CRUpdate = Creature -> World -> (World -> World, Maybe Creature) data Universe = Universe { _uvWorld :: World , _preloadData :: PreloadData @@ -63,13 +62,13 @@ data Universe = Universe , _config :: Configuration } data World = World - { _keys :: !(S.Set Scancode) - , _mouseButtons :: !(S.Set MouseButton) - , _mousePos :: !Point2 - , _cameraCenter :: !Point2 - , _cameraRot :: !Float - , _cameraZoom :: !Float - , _cameraViewFrom :: !Point2 + { _keys :: S.Set Scancode + , _mouseButtons :: S.Set MouseButton + , _mousePos :: Point2 + , _cameraCenter :: Point2 + , _cameraRot :: Float + , _cameraZoom :: Float + , _cameraViewFrom :: Point2 , _creatures :: IM.IntMap Creature , _creaturesZone :: Zone (IM.IntMap Creature) , _creatureGroups :: IM.IntMap CrGroupParams @@ -78,8 +77,8 @@ data World = World , _cloudsZone :: Zone [Cloud] , _props :: IM.IntMap Prop , _instantParticles :: [Particle] - , _particles :: ![Particle] - , _walls :: !(IM.IntMap Wall) + , _particles :: [Particle] + , _walls :: (IM.IntMap Wall) , _doors :: IM.IntMap Door , _machines :: IM.IntMap Machine , _magnets :: IM.IntMap Magnet @@ -92,7 +91,7 @@ data World = World , _randGen :: StdGen , _testString :: World -> [String] , _modifications :: IM.IntMap Modification - , _yourID :: !Int + , _yourID :: Int , _worldEvents :: World -> World , _delayedEvents :: [(Int,World -> World)] , _pressPlates :: IM.IntMap PressPlate @@ -102,16 +101,16 @@ data World = World , _decorations :: IM.IntMap Picture , _foregroundShape :: Shape , _corpses :: Zone [Corpse] - , _clickMousePos :: !Point2 + , _clickMousePos :: Point2 , _pathGraph :: ~(Gr Point2 Float) , _pathGraphP :: ~[(Point2,Point2)] , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) - , _carteDisplay :: !Bool - , _carteCenter :: !Point2 - , _carteZoom :: !Float - , _carteRot :: !Float - , _lightSources :: !(IM.IntMap LightSource) - , _tempLightSources :: ![TempLightSource] + , _carteDisplay :: Bool + , _carteCenter :: Point2 + , _carteZoom :: Float + , _carteRot :: Float + , _lightSources :: (IM.IntMap LightSource) + , _tempLightSources :: [TempLightSource] , _closeObjects :: [Either FloorItem Button] , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int @@ -229,7 +228,6 @@ data Creature = Creature , _crTwist :: Float , _crID :: Int , _crPict :: Creature -> Configuration -> World -> SPic - --, _crUpdate :: Creature -> World -> (Endo World, Maybe Creature) , _crUpdate :: Creature -> World -> World , _crRad :: Float , _crMass :: Float @@ -246,7 +244,7 @@ data Creature = Creature , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature) , _crStance :: Stance , _crActionPlan :: ActionPlan - , _crMeleeCooldown :: !Int + , _crMeleeCooldown :: Int , _crPerception :: PerceptionState , _crMemory :: MemoryState , _crVocalization :: Vocalization diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index ee0f70aa8..5c55e2c79 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -12,8 +12,8 @@ applyTerminalString :: String -> Universe -> Universe applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory & uvWorld . creatures . ix 0 . crInvCapacity .~ 50 -applyTerminalString "GODON" u = u & uvWorld . creatures . ix 0 . crUpdate .~ toCrUpdate (stateUpdateDamage clearDamage yourControl) -applyTerminalString "GODOFF" u = u & uvWorld . creatures . ix 0 . crUpdate .~ toCrUpdate (stateUpdate yourControl) +applyTerminalString "GODON" u = u & uvWorld . creatures . ix 0 . crUpdate .~ toCrUpdate' (stateUpdateDamage clearDamage yourControl) +applyTerminalString "GODOFF" u = u & uvWorld . creatures . ix 0 . crUpdate .~ stateUpdate yourControl applyTerminalString "LOADTEST" w = w & uvWorld . creatures . ix 0 . crInv .~ testInventory & uvWorld . creatures . ix 0 . crInvCapacity .~ 50 applyTerminalString "LM" w = applyTerminalString "LOADME" w diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index eebccf5f1..e458c135f 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -30,7 +30,7 @@ defaultCreature = Creature , _crMvDir = 0 , _crTwist = 0 , _crID = 1 - , _crPict = \_ _ _ -> (,) mempty blank + , _crPict = \_ _ _ -> mempty , _crUpdate = const id , _crRad = 10 , _crMass = 10 @@ -60,6 +60,8 @@ defaultCreature = Creature , _crGroup = LoneWolf , _crMvType = defaultAimMvType } +defaultInanimate :: Creature +defaultInanimate = defaultCreature & crActionPlan .~ Inanimate defaultCreatureMemory :: MemoryState defaultCreatureMemory = MemoryState diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index 7a24d949c..e1d20fdcd 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -6,6 +6,7 @@ module Dodge.Item.Weapon.BulletGun.Cane , autoRifle , assaultRifle , miniGun + , miniGun' ) where import Dodge.Item.Weapon.BulletGun.Clip import Dodge.Data @@ -185,6 +186,8 @@ assaultRifle = repeater , withMuzFlareI , withRecoilI 50 ] +miniGun' :: Item +miniGun' = miniGun & itConsumption . ammoLoaded .~ 0 miniGun :: Item miniGun = defaultAutoGun { _itName = "MINIGUN"