320 lines
11 KiB
Haskell
320 lines
11 KiB
Haskell
module Dodge.Creature.State (
|
|
stateUpdate,
|
|
doDamage,
|
|
) where
|
|
|
|
import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
|
|
import Control.Applicative
|
|
import Data.Foldable
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
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.World
|
|
import Dodge.EnergyBall
|
|
--import Dodge.Equipment
|
|
import Dodge.Euse
|
|
import Dodge.Hammer
|
|
import Dodge.ItEffect
|
|
import Dodge.LightSource.Torch
|
|
import Dodge.Prop.Gib
|
|
import Dodge.Reloading
|
|
import Dodge.SoundLogic
|
|
import Dodge.Targeting
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import Picture
|
|
import RandomHelp
|
|
import Shape
|
|
import ShapePicture
|
|
|
|
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
|
|
-}
|
|
stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
|
|
stateUpdate f =
|
|
foldCr
|
|
[ doDamage -- these two
|
|
, checkDeath -- must be in this order 24/7/22
|
|
, internalHammerUpdate
|
|
, f
|
|
, movementSideEff
|
|
, updateInv -- upInv must be called before invSideEff 22.05.23
|
|
, invSideEff
|
|
, equipmentEffects
|
|
, heldAimEffects
|
|
]
|
|
|
|
heldAimEffects :: Creature -> World -> World
|
|
heldAimEffects cr = fromMaybe id $ do
|
|
guard (crIsAiming cr)
|
|
ipos <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
itm <- cr ^? crInv . ix ipos
|
|
f <- itm ^? itEffect . ieWhileAiming
|
|
return $ doInvEffect f itm cr
|
|
|
|
checkDeath :: Creature -> World -> World
|
|
checkDeath cr w
|
|
| _crHP cr > 0 = w
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
|
|
| otherwise =
|
|
w
|
|
-- & creatures . at (_crID cr) .~ Nothing
|
|
& dropByState cr
|
|
& removecr
|
|
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
|
& corpseOrGib cr
|
|
where
|
|
removecr
|
|
| _crID cr == 0 =
|
|
(cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
|
|
. (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
|
|
|
|
corpseOrGib :: Creature -> World -> World
|
|
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
|
|
Just (FLAMING, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
|
|
Just (ELECTRICAL, _) -> w & plNew (cWorld . lWorld . corpses) cpID thecorpse
|
|
Just (POISONDAM, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
|
|
_
|
|
| _crPastDamage cr > 200 ->
|
|
w & addCrGibs cr
|
|
& bloodPuddleAt cpos
|
|
& bloodPuddleAt cpos
|
|
& bloodPuddleAt cpos
|
|
_ ->
|
|
w
|
|
& bloodPuddleAt cpos
|
|
& bloodPuddleAt cpos
|
|
& plNew (cWorld . lWorld . corpses) cpID thecorpse
|
|
where
|
|
cpos = _crPos cr
|
|
thecorpse = makeDefaultCorpse cr
|
|
|
|
scorchSPic :: SPic -> SPic
|
|
scorchSPic =
|
|
over _1 $
|
|
overColSH (mixColors 0.9 0.1 black . normalizeColor)
|
|
|
|
poisonSPic :: SPic -> SPic
|
|
poisonSPic =
|
|
over _1 $
|
|
overColSH (mixColors 0.5 0.5 green . normalizeColor)
|
|
|
|
--scorchSPic :: World -> SPic -> SPic
|
|
--scorchSPic w sp = evalState (scorchSPic' sp) (_randGen w)
|
|
--
|
|
--scorchSPic' :: SPic -> State StdGen SPic
|
|
--scorchSPic' = _1 $ overColSHM $ \col -> takeOne [col,black]
|
|
---- (return . mixColorsLinear 0.9 0.1 black)
|
|
|
|
bloodPuddleAt :: Point2 -> World -> World
|
|
bloodPuddleAt p w =
|
|
w
|
|
& snd
|
|
. plNewID
|
|
(cWorld . lWorld . decorations)
|
|
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
|
|
& randGen .~ g
|
|
where
|
|
(q, g) = randInCirc 10 & runState $ _randGen w
|
|
|
|
internalHammerUpdate :: Creature -> World -> World
|
|
internalHammerUpdate cr =
|
|
cWorld . lWorld . creatures . ix (_crID cr)
|
|
%~ ( (crHammerPosition %~ moveHammerUp)
|
|
. stepReloading
|
|
. updateMovement
|
|
)
|
|
|
|
{- | Drop items according to the creature state.
|
|
TODO make sure this doesn't mess up any ItemPosition
|
|
-}
|
|
dropByState :: Creature -> World -> World
|
|
dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath of
|
|
DropAll -> IM.keys $ _crInv cr
|
|
DropSpecific xs -> xs
|
|
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
|
|
|
|
doDamage :: Creature -> World -> World
|
|
doDamage cr w =
|
|
w
|
|
& applyPastDamages cr
|
|
& applyCreatureDamage dams cr
|
|
where
|
|
dams = _csDamage $ _crState cr
|
|
|
|
-- TODO generalise shake to arbitrary damage amounts
|
|
applyPastDamages :: Creature -> World -> World
|
|
applyPastDamages cr w
|
|
| _crPastDamage cr > 200 =
|
|
let (p, g) = runState (randInCirc 3) (_randGen w)
|
|
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
|
|
& randGen .~ g
|
|
| _crPastDamage cr > 20 =
|
|
let (p, g) = runState (randInCirc 2) (_randGen w)
|
|
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
|
|
& randGen .~ g
|
|
| _crPastDamage cr > 0 =
|
|
let (p, g) = runState (randInCirc 1) (_randGen w)
|
|
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
|
|
& randGen .~ g
|
|
| otherwise = w
|
|
|
|
movementSideEff :: Creature -> World -> World
|
|
movementSideEff cr w
|
|
| hasJetPack = case cr ^? crStance . carriage of
|
|
Just (Boosting v) ->
|
|
w
|
|
& randGen .~ g
|
|
& makeFlamelet
|
|
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
|
|
20
|
|
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
|
|
1
|
|
20
|
|
_ -> w
|
|
| otherwise = footstepSideEffect cr w
|
|
where
|
|
hasJetPack = any (\it -> it ^? itType . iyBase == Just (EQUIP JETPACK)) $ _crInv cr
|
|
oldPos = _crOldPos cr
|
|
momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
|
|
momentum''
|
|
| magV momentum' > 3 = 3 *.* normalizeV momentum'
|
|
| otherwise = momentum'
|
|
momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
|
|
(randDir, g) = randomR (-0.5, 0.5) $ _randGen w
|
|
(randAng, _) = randomR (0, 2 * pi) $ _randGen w
|
|
|
|
useUpdate :: ItemUse -> ItemUse
|
|
useUpdate =
|
|
(heldHammer %~ moveHammerUp)
|
|
. (leftHammer %~ moveHammerUp)
|
|
. (leftDelay . rateTime %~ decreaseToZero)
|
|
. (heldDelay . warmTime %~ decreaseToZero)
|
|
. (heldDelay . rateTime %~ decreaseToZero)
|
|
|
|
useEquipment :: Creature -> Int -> World -> World
|
|
useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr
|
|
where
|
|
itm = _crInv cr IM.! i
|
|
|
|
-- a map updating all inventory items
|
|
updateInv :: Creature -> World -> World
|
|
updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
|
|
|
|
-- a loop going over equipped items
|
|
equipmentEffects :: Creature -> World -> World
|
|
equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
|
|
|
|
-- a loop going over all inventory items
|
|
invSideEff :: Creature -> World -> World
|
|
invSideEff cr w =
|
|
updateTargeting (crGetTargeting cr) cr $
|
|
weaponReloadSounds cr $
|
|
IM.foldl' f w (_crInv cr)
|
|
where
|
|
-- be careful with side effects that affect creature targeting
|
|
|
|
f w' it =
|
|
itemInvSideEffect cr it $
|
|
--doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
|
|
w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
|
|
|
|
itemInvSideEffect :: Creature -> Item -> World -> World
|
|
itemInvSideEffect cr it
|
|
| hastorchattach = createAttachLight cr it
|
|
| otherwise = id
|
|
where
|
|
hastorchattach = it ^? itType . iyModules . ix ModHeldAttach == Just ATTACHTORCH && _itIsHeld it
|
|
|
|
createAttachLight :: Creature -> Item -> World -> World
|
|
createAttachLight cr it = createTorchLightOffset cr it attachoff
|
|
where
|
|
attachoff = it ^?! itDimension . dimAttachPos
|
|
|
|
itemUpdate :: Creature -> Int -> Item -> Item
|
|
itemUpdate cr i =
|
|
updateAutoRecharge
|
|
. (itUse %~ useUpdate)
|
|
. (itLocation .~ InInv (_crID cr) i)
|
|
. (itIsHeld .~ itmisheld)
|
|
where
|
|
itmisheld = Just i == (cr ^? crManipulation . manObject . inInventory . ispItem)
|
|
|
|
updateAutoRecharge :: Item -> Item
|
|
updateAutoRecharge it = case it ^? itUse . leftConsumption of
|
|
Just (AutoRecharging l m t p)
|
|
| l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l + 1) m t t
|
|
| l < m -> it & itUse . leftConsumption . arProgress -~ 1
|
|
_ -> it
|
|
|
|
-- I feel like there should be a centralised function that supersumes this
|
|
-- i.e. a function that deals with all states that depend upon item positioning
|
|
-- in the inventory
|
|
crGetTargeting :: Creature -> Maybe TargetType
|
|
crGetTargeting cr = do
|
|
i <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
itm <- cr ^? crInv . ix i
|
|
itm ^? itType . iyModules . ix ModTarget . imtTargetType
|
|
<|> do
|
|
tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtAttach . ibtAttachTarget
|
|
guard (canAttachTargeting tt itm)
|
|
return tt
|
|
<|> do
|
|
tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
|
|
guard (canAttachTargeting tt itm)
|
|
return tt
|
|
|
|
weaponReloadSounds :: Creature -> World -> World
|
|
weaponReloadSounds cr w = case cr ^? crManipulation . manObject . inInventory . iselAction of
|
|
Just ReloadAction{_reloadAction = la} ->
|
|
soundContinue
|
|
(CrReloadSound cid)
|
|
(_crPos cr)
|
|
(_actionSound la)
|
|
(Just 1)
|
|
w
|
|
_ -> w
|
|
where
|
|
cid = _crID cr
|
|
|
|
updateMovement :: Creature -> Creature
|
|
updateMovement cr
|
|
| isFrictionless cr = over crPos (+.+ momentum) cr
|
|
| otherwise = updateWalkCycle cr
|
|
where
|
|
momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
|
|
momentum''
|
|
| magV momentum' > 1 = 1 *.* normalizeV momentum'
|
|
| otherwise = momentum'
|
|
momentum = momentum''
|
|
|
|
isFrictionless :: Creature -> Bool
|
|
isFrictionless cr = case cr ^? crStance . carriage of
|
|
Just (Boosting _) -> True
|
|
Just Floating -> True
|
|
_ -> False
|