justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Tweak creature update

Browse Source
This commit is contained in:
justin
2025-08-06 13:10:37 +01:00
parent af5bdf59b9
commit 9fb7440776
11 changed files with 196 additions and 191 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Barreloid.hs
+1 -1
View File
@@ -40,7 +40,7 @@ updateExpBarrel ps cr w
updateBarrel :: Creature -> World -> World
updateBarrel cr
| _crHP cr > 0 = doDamage cr
| _crHP cr > 0 = doDamage (cr ^. crID)
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
damsToExpBarrel :: [Damage] -> Creature -> Creature
src/Dodge/Creature/State.hs
+11 -93
View File
@@ -1,6 +1,7 @@
module Dodge.Creature.State (
crUpdate,
-- crUpdate,
doDamage,
invItemEffs,
) where
import Control.Applicative
@@ -10,15 +11,10 @@ import Data.Maybe
import Data.Monoid
import Dodge.Base
import Dodge.BaseTriggerType
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Damage
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.ComposedItem
import Dodge.Data.Damage.Type
import Dodge.Data.DoubleTree
--import Dodge.Data.DoubleTree
import Dodge.Data.World
@@ -31,100 +27,21 @@ import Dodge.Item.Grammar
import Dodge.Item.HeldOffset
import Dodge.Item.Location
import Dodge.Item.MaxAmmo
import Dodge.Prop.Gib
import Dodge.SoundLogic
import Dodge.Targeting.Draw
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
import qualified Quaternion as Q
import RandomHelp
import qualified SDL
import Shape
import ShapePicture
-- this can almost certainly be made more efficient
foldCr :: [Creature -> World -> World] -> Creature -> World -> World
foldCr xs cr w = foldl' f w xs
where
f w' g = case w' ^? cWorld . lWorld . creatures . ix (_crID cr) of
Just cr' -> g cr' w'
Nothing -> w'
{- | this seems to work, but I am not sure about the ordering:
previously, the movement was updated before the ai in order to correctly set the oldpos.
This should be made more sensible: should the movement side effects apply to
the creature before or after it has moved?
at what point invSideEffects is applied wrt to when the creature moves
may affect whether the shield moves correctly
-}
crUpdate :: (Creature -> World -> World) -> Creature -> World -> World
crUpdate f =
foldCr
[ doDamage -- these two
, checkDeath -- must be in this order 24/7/22
, updateWalkCycle
, f
, invItemEffs
]
-- I have changed the ordering of item/equipment effects, which may have
-- unforseen consequences, be aware
checkDeath :: Creature -> World -> World
checkDeath cr w
| _crHP cr > 0 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
| _crHP cr <= -200 =
w
& dropAll cr -- the order of
& removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& addCrGibs cr
| _crHP cr > -200 && _crDeathTimer cr < 5 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
& cWorld . lWorld . creatures . ix (_crID cr) . crDeathTimer +~ 1
| otherwise =
w
& dropAll cr -- the order of
& removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
where
removecr
| _crID cr == 0 = id
-- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
_ -> addcorpse thecorpse
where
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse cr
scorchSPic :: SPic -> SPic
scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
poisonSPic :: SPic -> SPic
poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
-- reverse keys, otherwise two or more inv items will cause errors
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
doDamage :: Creature -> World -> World
doDamage cr = applyPastDamages cr . applyCreatureDamage (cr ^. crDamage) cr
doDamage :: Int -> World -> World
doDamage cid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
return $ applyPastDamages cr $ applyCreatureDamage (cr ^. crDamage) cr w
-- TODO generalise shake to arbitrary damage amounts
applyPastDamages :: Creature -> World -> World
@@ -141,12 +58,13 @@ applyPastDamages cr w
& randGen .~ g
-- a loop going over all root inventory items
invItemEffs :: Creature -> World -> World
invItemEffs cr =
appEndo $
invItemEffs :: Int -> World -> World
invItemEffs cid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
return . appEndo (
foldMap
(reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
(invDT' (_crInv cr))
(invDT' (_crInv cr))) $ w
invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
src/Dodge/Creature/State/WalkCycle.hs
+17 -19
View File
@@ -1,37 +1,35 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.State.WalkCycle (
updateWalkCycle,
) where
module Dodge.Creature.State.WalkCycle (updateWalkCycle) where
import Control.Lens
import Dodge.Data.World
import Dodge.SoundLogic
import Sound.Data
updateWalkCycle :: Creature -> World -> World
updateWalkCycle cr =
case cr ^. crStance . carriage of
Walking x ff
| x > cr ^. crStance . strideLength ->
soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos)
(chooseFootSound ff)
Nothing
. over (cWorld . lWorld . creatures . ix (cr ^. crID) . crStance . carriage) resetStride
_ -> id
updateWalkCycle :: Int -> World -> World
updateWalkCycle cid w
| Just cr <- w ^? cWorld . lWorld . creatures . ix 0
, Walking x ff <- cr ^. crStance . carriage
, x > cr ^. crStance . strideLength =
w
& soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos)
(chooseFootSound ff)
Nothing
& over (cWorld . lWorld . creatures . ix cid . crStance . carriage) resetStride
| otherwise = w
resetStride :: Carriage -> Carriage
resetStride (Walking _ ff) = Walking 0 (normalGait ff)
resetStride x = x
resetStride = \case
Walking _ ff -> Walking 0 (normalGait ff)
x -> x
normalGait :: FootForward -> FootForward
normalGait = \case
LeftForward -> RightForward
WasLeftForward -> RightForward
RightForward -> LeftForward
WasRightForward -> LeftForward
chooseFootSound :: FootForward -> SoundID
chooseFootSound LeftForward = foot1S
src/Dodge/Creature/Update.hs
+118 -25
View File
@@ -1,47 +1,140 @@
module Dodge.Creature.Update (
updateCreature,
) where
module Dodge.Creature.Update (updateCreature) where
import Dodge.Inventory
import LensHelp
import Geometry
import Dodge.SoundLogic
import Dodge.Creature.Radius
import Dodge.Creature.YourControl
import Dodge.Creature.State
import Color
import qualified Data.IntMap.Strict as IM
import qualified Data.List as List
import Dodge.Barreloid
import Dodge.Base.NewID
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Radius
import Dodge.Creature.State
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.YourControl
import Dodge.Damage
import Dodge.Data.Damage.Type
import Dodge.Data.World
import Dodge.Humanoid
import Dodge.Inventory
import Dodge.Lampoid
import qualified Data.List as List
import Dodge.Prop.Gib
import Dodge.SoundLogic
import FoldableHelp
import Geometry
import LensHelp
import Shape
import ShapePicture.Data
-- Should separate out creature movement from other parts here
-- allow for knockbacks etc to be determined as well as intended movements
updateCreature :: Creature -> World -> World
updateCreature cr
| _crZ cr < negate 100 = destroyAllInvItems cr
| _crZ cr < 0 = (tocr . crZVel -~ 0.5)
| _crZ cr < 0 =
(tocr . crZVel -~ 0.5)
. (tocr . crZ +~ _crZVel cr)
| otherwise = updateCreature' cr
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
updateCreature' :: Creature -> World -> World
updateCreature' cr = chasmTest cr . case _crType cr of
Avatar{} -> (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
. crUpdate yourControl cr
LampCrit{} -> updateLampoid cr
BarrelCrit bt -> updateBarreloid bt cr
AvatarDead -> id
_ -> crUpdate updateHumanoid cr
updateCreature' cr =
chasmTest cr . case _crType cr of
Avatar{} ->
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
. crUpdate' yourControl cr
LampCrit{} -> updateLampoid cr
BarrelCrit bt -> updateBarreloid bt cr
AvatarDead -> id
_ -> crUpdate' updateHumanoid cr
{- | this seems to work, but I am not sure about the ordering:
previously, the movement was updated before the ai in order to correctly set the oldpos.
This should be made more sensible: should the movement side effects apply to
the creature before or after it has moved?
at what point invSideEffects is applied wrt to when the creature moves
may affect whether the shield moves correctly
-}
crUpdate' :: (Creature -> World -> World) -> Creature -> World -> World
crUpdate' f cr =
checkDeath cid
. doDamage cid
. invItemEffs cid
. g
. updateWalkCycle cid
where
cid = (cr ^. crID)
g w' = maybe id f (w' ^? cWorld . lWorld . creatures . ix cid) w'
checkDeath :: Int -> World -> World
checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
checkDeath' :: Creature -> World -> World
checkDeath' cr w
| _crHP cr > 0 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
| _crHP cr <= -200 =
w
& dropAll cr -- the order of
& destroyCreature cr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& addCrGibs cr
| _crHP cr > -200 && _crDeathTimer cr < 5 =
w
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
& cWorld . lWorld . creatures . ix (_crID cr) . crDeathTimer +~ 1
| otherwise =
w
& dropAll cr -- the order of
& removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
where
removecr
| _crID cr == 0 = id
-- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
destroyCreature :: Creature -> World -> World
destroyCreature cr
| _crID cr == 0 = id
-- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
_ -> addcorpse thecorpse
where
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse cr
scorchSPic :: SPic -> SPic
scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
poisonSPic :: SPic -> SPic
poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
-- reverse keys, otherwise two or more inv items will cause errors
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
chasmTest :: Creature -> World -> World
chasmTest cr w
| _crZVel cr < 0 = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
& cWorld . lWorld . creatures . ix (_crID cr) . crZ +~ _crZVel cr
| Just (x,y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) = w
& soundContinue (CrChasm (_crID cr)) (_crPos cr) debrisS (Just 100)
& cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ normalizeV (vNormal (x-y))
| _crZVel cr < 0 =
w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
& cWorld . lWorld . creatures . ix (_crID cr) . crZ +~ _crZVel cr
| Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) =
w
& soundContinue (CrChasm (_crID cr)) (_crPos cr) debrisS (Just 100)
& cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ normalizeV (vNormal (x - y))
| any f (w ^. cWorld . chasms) = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
| otherwise = w
where
@@ -49,6 +142,6 @@ chasmTest cr w
f = circInPolygon (_crPos cr) (crRad $ cr ^. crType)
updatePulse :: Pulse -> Pulse
updatePulse PulseStatus {_pulseRate = pr, _pulseProgress = pp}
updatePulse PulseStatus{_pulseRate = pr, _pulseProgress = pp}
| pp >= pr = PulseStatus pr 0
| otherwise = PulseStatus pr (pp + 1)
src/Dodge/Data/Creature/Stance.hs
+1 -5
View File
@@ -28,11 +28,7 @@ data Carriage
| Boosting Point2
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data FootForward
= LeftForward
| RightForward
| WasLeftForward
| WasRightForward
data FootForward = LeftForward | RightForward
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Posture
src/Dodge/Default/Creature.hs
+1 -1
View File
@@ -38,7 +38,7 @@ defaultCreature =
-- , _crHotkeys = M.empty
, _crStance =
Stance
{ _carriage = Walking 0 WasLeftForward
{ _carriage = Walking 0 LeftForward
, _posture = AtEase
, _strideLength = yourDefaultStrideLength
}
src/Dodge/Humanoid.hs
+12 -12
View File
@@ -187,18 +187,18 @@ humanoidAIList ::
humanoidAIList
= impulsiveAIBefore . chainCreatureUpdates
-- bit of a hack to get new random generators after each creature's update
defaultImpulsive ::
[World -> Creature -> Creature] ->
Creature ->
World ->
World
defaultImpulsive
= fmap (fmap updateRandGen) . crUpdate . impulsiveAIBefore . chainCreatureUpdates
where
updateRandGen w =
let (_, g) = randomR (0, 1 :: Int) (_randGen w)
in w & randGen .~ g
---- bit of a hack to get new random generators after each creature's update
--defaultImpulsive ::
-- [World -> Creature -> Creature] ->
-- Creature ->
-- World ->
-- World
--defaultImpulsive
-- = fmap (fmap updateRandGen) . crUpdate . impulsiveAIBefore . chainCreatureUpdates
-- where
-- updateRandGen w =
-- let (_, g) = randomR (0, 1 :: Int) (_randGen w)
-- in w & randGen .~ g
chooseMovementPistol :: Creature -> World -> Action
chooseMovementPistol cr w =
src/Dodge/Lampoid.hs
+1 -1
View File
@@ -27,7 +27,7 @@ updateLampoid cr w = case cr ^?! crType . lampLSID of
| otherwise ->
w
& cWorld . lWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos
& doDamage cr
& doDamage (cr ^. crID)
where
cpos = _crPos cr
cid = _crID cr