223 lines
7.9 KiB
Haskell
223 lines
7.9 KiB
Haskell
module Dodge.Creature.State
|
|
( stateUpdate
|
|
, doDamage
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Hammer
|
|
import Dodge.Reloading
|
|
import Dodge.Prop.Gib
|
|
import Dodge.Base
|
|
import Dodge.Creature.State.WalkCycle
|
|
import Dodge.Creature.Impulse.Movement
|
|
--import Dodge.Creature.Test
|
|
--import Dodge.Base
|
|
import Dodge.SoundLogic
|
|
import Dodge.RandomHelp
|
|
import Dodge.WorldEvent
|
|
--import Dodge.WallCreatureCollisions
|
|
import Dodge.Creature.Action
|
|
--import Dodge.Hammer
|
|
import Geometry
|
|
--import Picture
|
|
import qualified IntMapHelp as IM
|
|
--import StrictHelp
|
|
|
|
--import qualified Data.IntSet as IS
|
|
--import Data.Maybe
|
|
import Data.Function
|
|
import Control.Lens
|
|
--import Control.Applicative
|
|
import Control.Monad.State
|
|
--import Control.Monad
|
|
--import qualified SDL
|
|
--import qualified SDL.Mixer as Mix
|
|
import System.Random
|
|
--import qualified Data.Set as S
|
|
--import qualified Data.Map as M
|
|
--import qualified Data.Vector as V
|
|
--import qualified Data.Vector.Mutable as MV
|
|
|
|
foldCr :: [Creature -> World -> World]
|
|
-> Creature -> World -> World
|
|
--foldCr xs cr w = foldr ($ cr) w xs
|
|
foldCr xs cr w = foldr f w xs
|
|
where
|
|
f g w' = case w' ^? 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
|
|
, equipmentEffects
|
|
, invSideEff
|
|
, upInv -- upInv must be called before invSideEff 22.05.23
|
|
, movementSideEff
|
|
, f
|
|
, internalUpdate
|
|
, checkDeath
|
|
]
|
|
|
|
checkDeath :: Creature -> World -> World
|
|
checkDeath cr w
|
|
| _crHP cr > 0 = w
|
|
| otherwise = w
|
|
-- & creatures . at (_crID cr) .~ Nothing
|
|
& removecr
|
|
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
|
& plNew corpses cpID thecorpse
|
|
& dropByState cr
|
|
where
|
|
removecr
|
|
| _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id)
|
|
. (creatures . ix (_crID cr) . crPict .~ const mempty)
|
|
. addCrGibs cr
|
|
| otherwise = creatures . at (_crID cr) .~ Nothing
|
|
thecorpse = Corpse
|
|
{ _cpID = 0
|
|
, _cpPos = _crPos cr
|
|
, _cpDir = _crDir cr
|
|
, _cpPict = _crCorpse cr cr
|
|
, _cpRes = Nothing
|
|
}
|
|
|
|
internalUpdate :: Creature -> World -> World
|
|
internalUpdate cr = 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 . crDropsOnDeath 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
|
|
& creatures . ix (_crID cr) . crState . crDamage .~ []
|
|
& applyPastDamages cr
|
|
& _crApplyDamage cr dams cr
|
|
where
|
|
dams = _crDamage $ _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 & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
|
|
& randGen .~ g
|
|
| _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w)
|
|
in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
|
|
& randGen .~ g
|
|
| _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w)
|
|
in w & 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))
|
|
Nothing
|
|
1
|
|
20
|
|
_ -> w
|
|
| otherwise = footstepSideEffect cr w
|
|
where
|
|
hasJetPack = any (\it -> it ^? itType == Just 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 = (useHammer . hammerPosition %~ moveHammerUp)
|
|
. (useDelay . warmTime %~ decreaseToZero)
|
|
. (useDelay . rateTime %~ decreaseToZero)
|
|
|
|
useEquipment :: Creature -> Int -> World -> World
|
|
useEquipment cr i = _eqUse (_itUse itm) itm cr
|
|
where
|
|
itm = _crInv cr IM.! i
|
|
-- a map updating all inventory items
|
|
upInv :: Creature -> World -> World
|
|
upInv cr = creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
|
|
-- a loop going over equipped items
|
|
equipmentEffects :: Creature -> World -> World
|
|
equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
|
|
-- a loop going over all inventory items
|
|
invSideEff :: Creature -> World -> World
|
|
invSideEff cr w = weaponReloadSounds cr
|
|
$ IM.foldrWithKey f w (_crInv cr)
|
|
where
|
|
f i it w' = doItemTargeting i cr w' & case it ^? itEffect . itInvEffect of
|
|
Nothing -> id
|
|
Just g -> g it cr
|
|
|
|
itemUpdate :: Creature -> Int -> Item -> Item
|
|
itemUpdate cr i
|
|
| i == _crInvSel cr = baseupdate True
|
|
| otherwise = baseupdate False
|
|
where
|
|
baseupdate bool = (itUse %~ useUpdate) . (itInvPos ?~ i) . (itIsHeld .~ bool)
|
|
|
|
doItemTargeting :: Int -> Creature -> World -> World
|
|
doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
|
|
Nothing -> w
|
|
Just NoTargeting -> w
|
|
Just t -> let (w',t') = _tgUpdate t (_crInv cr IM.! invid) cr w t
|
|
in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
|
|
|
|
weaponReloadSounds :: Creature -> World -> World
|
|
weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
|
|
Just am@LoadableAmmo{} -> case _reloadType am of
|
|
PassiveReload stype |Just' (_reloadTime am) == _reloadState am
|
|
-> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
|
|
PassiveReload _ -> w
|
|
ActiveClear | _reloadState am == Just' 0 -> stopSoundFrom (CrReloadSound cid) w
|
|
ActiveClear | _reloadState am == Nothing' -> w
|
|
ActiveClear -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
|
|
ActivePartial{} | _reloadState am == Just' 0 -> stopSoundFrom (CrReloadSound cid) w
|
|
ActivePartial{} | _reloadState am == Nothing' -> w
|
|
ActivePartial{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
|
|
Just ChargeableAmmo {} -> w
|
|
Just NoConsumption {} -> w
|
|
Just ItemItselfConsumable {} -> w
|
|
Nothing -> 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
|