Cleanup, trying to diagnose space leak in crit update

This commit is contained in:
2021-12-09 22:12:44 +00:00
parent bd94044445
commit 3c35a04531
23 changed files with 203 additions and 178 deletions
+7 -6
View File
@@ -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
+2 -5
View File
@@ -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)
+1 -2
View File
@@ -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 >=>
+1 -2
View File
@@ -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 = []
+1 -2
View File
@@ -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 >=>
+10 -5
View File
@@ -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
+12 -105
View File
@@ -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
+1 -2
View File
@@ -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])
+1 -2
View File
@@ -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)
+41
View File
@@ -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))
+1 -2
View File
@@ -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)
+50 -6
View File
@@ -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
+32 -2
View File
@@ -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]
+1 -2
View File
@@ -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)
+4 -4
View File
@@ -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
+1 -2
View File
@@ -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]
+6
View File
@@ -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)
+1 -2
View File
@@ -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 )
+3 -3
View File
@@ -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
+19 -21
View File
@@ -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
+2 -2
View File
@@ -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
+3 -1
View File
@@ -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
+3
View File
@@ -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"