204 lines
7.4 KiB
Haskell
204 lines
7.4 KiB
Haskell
module Dodge.Creature.State
|
|
( stateUpdate
|
|
, stateUpdateDamage
|
|
, doDamage
|
|
, clearDamage
|
|
, invSideEff
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Hammer
|
|
import Dodge.Reloading
|
|
import Dodge.Base
|
|
import Dodge.Creature.State.WalkCycle
|
|
--import Dodge.Creature.Test
|
|
--import Dodge.Base
|
|
import Dodge.SoundLogic
|
|
import Dodge.RandomHelp
|
|
import Dodge.WorldEvent
|
|
--import Dodge.WallCreatureCollisions
|
|
import Dodge.Creature.Action
|
|
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
|
|
|
|
-- | The movement is 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?
|
|
-- currently invSideEffects are applied after the creature moves, to correctly
|
|
-- update shield positions
|
|
stateUpdate :: (Creature -> World -> (World -> World, Creature))
|
|
-> Creature -> World -> World
|
|
stateUpdate = stateUpdateDamage doDamage
|
|
|
|
stateUpdateDamage :: (Creature -> Creature)
|
|
-> (Creature -> World -> (World -> World, Creature))
|
|
-- -> CRUpdate
|
|
-> Creature -> World -> World
|
|
stateUpdateDamage damageupdate u cr w = case u (updateMovement cr) w of
|
|
(f, upcr) -> invSideEff upcr . movementSideEff cr . deathEff . f $ w
|
|
& creatures . at (_crID cr) .~ (stepReloading . damageupdate <$> crOrCorpse upcr)
|
|
where
|
|
crOrCorpse cr'
|
|
| cr' ^. crHP > 0 = Just cr'
|
|
| otherwise = Nothing
|
|
deathEff
|
|
| cr ^.crHP > 0 = id
|
|
| otherwise = stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
|
. over decorations addCorpse
|
|
. dropByState cr
|
|
addCorpse = IM.insertNewKey
|
|
$ uncurryV translate (_crOldPos cr)
|
|
$ rotate (_crDir cr)
|
|
(_crCorpse cr)
|
|
-- | Drop items according to the creature state.
|
|
dropByState :: Creature -> World -> World
|
|
dropByState cr w = foldr (copyInvItemToFloor 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)
|
|
|
|
setOldPos :: Creature -> Creature
|
|
setOldPos cr = cr
|
|
& crOldPos .~ _crPos cr
|
|
& crOldDir .~ _crDir cr
|
|
|
|
clearDamage :: Creature -> Creature
|
|
clearDamage = crState . crDamage .~ []
|
|
|
|
doDamage :: Creature -> Creature
|
|
doDamage cr = set (crState . crDamage) []
|
|
. over (crState . crPastDamage) (advancePastDamages dams)
|
|
$ snd $ _crApplyDamage cr dams cr
|
|
where
|
|
dams = _crDamage $ _crState cr
|
|
|
|
advancePastDamages :: [Damage] -> V.Vector [Damage] -> V.Vector [Damage]
|
|
advancePastDamages newDs v = f $ V.backpermute v bpVector
|
|
where
|
|
f = V.modify $ \v' -> MV.write v' 0 newDs
|
|
|
|
bpVector :: V.Vector Int
|
|
bpVector = V.fromList $ 0 : [0 .. 18]
|
|
|
|
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
|
|
|
|
heldItemUpdate :: Item -> Item
|
|
heldItemUpdate = invItemUpdate
|
|
-- . (itUse %~ useupdate)
|
|
-- where
|
|
-- useupdate = id
|
|
|
|
invItemUpdate :: Item -> Item
|
|
invItemUpdate = itUse %~ useupdate
|
|
where
|
|
useupdate = (useHammer . hammerPosition %~ moveHammerUp)
|
|
. (useDelay . warmTime %~ decreaseToZero)
|
|
. (useDelay . rateTime %~ decreaseToZero)
|
|
|
|
invSideEff :: Creature -> World -> World
|
|
invSideEff cr w = weaponReloadSounds cr
|
|
. flip (IS.foldr useeq) (_crInvEquipped cr)
|
|
. doHeldItemTargeting cr
|
|
$ IM.foldrWithKey f w (_crInv cr)
|
|
where
|
|
useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
|
|
f i it w' = case it ^? itEffect . itInvEffect of
|
|
Nothing -> w' & doitemupdate
|
|
Just g -> g (_itEffect it) cr i w' & doitemupdate
|
|
where
|
|
doitemupdate
|
|
| i == _crInvSel cr = itpointer %~ heldItemUpdate
|
|
| otherwise = itpointer %~ invItemUpdate
|
|
itpointer = creatures . ix (_crID cr) . crInv . ix i
|
|
|
|
doHeldItemTargeting :: Creature -> World -> World
|
|
doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting of
|
|
Nothing -> w
|
|
Just NoTargeting -> w
|
|
Just t -> let (w',t') = _tgUpdate t (_crInv cr IM.! _crInvSel cr) cr w t
|
|
in w' & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . 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
|
|
|
|
--weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
|
|
-- Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadType = PassiveReload stype,_wpReloadTime=rt,_wpReloadState=rs} }
|
|
-- | rt == rs -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
|
|
-- | otherwise -> w
|
|
-- Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadState = 0}} -> w
|
|
-- Just Weapon{_wpAmmo=LoadableAmmo{_wpReloadState = 1}} -> stopSoundFrom (CrReloadSound cid) w
|
|
-- Just Weapon{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
|
|
-- _ -> w
|
|
-- where
|
|
-- cid = _crID cr
|
|
|
|
updateMovement :: Creature -> Creature
|
|
updateMovement cr
|
|
| isFrictionless cr = over crPos (+.+ momentum) $ setOldPos cr
|
|
| otherwise = updateWalkCycle $ setOldPos 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
|