230 lines
8.4 KiB
Haskell
230 lines
8.4 KiB
Haskell
module Dodge.Creature.State where
|
|
import Dodge.Data
|
|
import Dodge.Item.Data
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Creature.State.WalkCycle
|
|
import Dodge.Creature.Stance.Data
|
|
--import Dodge.Creature.Test
|
|
--import Dodge.Base
|
|
import Dodge.SoundLogic
|
|
import Dodge.SoundLogic.Synonyms
|
|
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 Data.List
|
|
--import Data.Char
|
|
--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
|
|
|
|
type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
|
|
meleeCooldown :: CRUpdate -> CRUpdate
|
|
meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
|
|
-- | The movement is updated before the ai in order to correctly set the oldpos.
|
|
-- the whole of this update cycle could do with a rethink, it is becoming
|
|
-- convoluted
|
|
stateUpdate :: CRUpdate -> CRUpdate
|
|
stateUpdate u w (f,g) cr = case u w (f,g) (updateMovement g cr) of
|
|
((f',g') , maybeCr) ->
|
|
( (invSideEff cr . movementSideEff cr . deathEff . f'
|
|
, g')
|
|
, fmap (stepReloading . stepItemUseCooldown . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr
|
|
)
|
|
where
|
|
crOrCorpse cr'''
|
|
| cr''' ^. crHP > 0 = Just cr'''
|
|
| otherwise = Nothing
|
|
deathEff
|
|
| cr ^.crHP > 0 = id
|
|
| otherwise = stopSoundFrom (CrWeaponSound (_crID cr))
|
|
. over decorations addCorpse
|
|
. dropByState cr
|
|
--crBeforeDeath = colCrWall w 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 (copyItemToFloor cr) w is
|
|
where
|
|
is :: [Int]
|
|
is = 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 = set crOldPos (_crPos cr) cr
|
|
{- |
|
|
Given a creature and a velocity, applies friction to that creature and evaluates a
|
|
velocity to carry across frames.
|
|
-}
|
|
crFriction :: Creature -> Point2 -> Point2
|
|
crFriction _ _ = V2 0 0
|
|
|
|
doDamage :: Creature -> Creature
|
|
doDamage cr = set (crState . crDamage) []
|
|
$ over (crState . crPastDamage) (forceFoldable . take 10 . (dams :) ) damagedCr
|
|
where
|
|
dams = _crDamage $ _crState cr
|
|
damagedCr = snd $ _crApplyDamage cr dams cr
|
|
|
|
movementSideEff :: Creature -> World -> World
|
|
movementSideEff cr w
|
|
| hasJetPack
|
|
= case cr ^? crStance . carriage of
|
|
Just (Boosting v)
|
|
-> makeFlameletTimed
|
|
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
|
|
20
|
|
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
|
|
Nothing
|
|
1
|
|
20
|
|
$ set randGen g
|
|
w
|
|
_ -> w
|
|
| otherwise = footstepSideEffect cr w
|
|
where
|
|
hasJetPack = any (\it -> it ^? itIdentity == 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
|
|
|
|
--crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
|
|
|
|
|
|
invSideEff :: Creature -> World -> World
|
|
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
|
|
where
|
|
f i it w' = case it ^? itEffect . itInvEffect of
|
|
Nothing -> w'
|
|
Just g -> g (_itEffect it) cr i w'
|
|
|
|
weaponReloadSounds :: Creature -> World -> World
|
|
weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
|
|
Just Weapon{_wpReloadType = PassiveReload stype,_wpReloadTime=rt,_wpReloadState=rs}
|
|
| rt == rs -> soundOncePos stype (_crPos cr) w
|
|
| otherwise -> w
|
|
Just Weapon{_wpReloadState = 0} -> w
|
|
Just Weapon{_wpReloadState = 1} -> stopSoundFrom (CrReloadSound cid) w
|
|
Just Weapon{} -> soundFrom (CrReloadSound cid) reloadSound 1 0 w
|
|
_ -> w
|
|
where
|
|
cid = _crID cr
|
|
|
|
updateMovement :: StdGen -> Creature -> Creature
|
|
updateMovement g 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'' +.+ 0.01 *.* unitVectorAtAngle randAng
|
|
(randAng,_) = randomR (0,2*pi) g
|
|
|
|
isFrictionless :: Creature -> Bool
|
|
isFrictionless cr = case cr ^? crStance . carriage of
|
|
Just (Boosting _) -> True
|
|
Just Floating -> True
|
|
_ -> False
|
|
|
|
stepItemUseCooldown :: Creature -> Creature
|
|
stepItemUseCooldown cr = over (crInv . ix iSel . itUseTime) decreaseToZero cr
|
|
where
|
|
iSel = _crInvSel cr
|
|
|
|
stepReloading :: Creature -> Creature
|
|
stepReloading cr
|
|
-- | crIsAiming' cr = cr
|
|
-- | otherwise
|
|
= over (crInv . ix iSel . wpReloadState) decreaseToZero cr
|
|
where
|
|
iSel = _crInvSel cr
|
|
|
|
decreaseToZero :: Int -> Int
|
|
decreaseToZero x = max 0 (x - 1)
|
|
|
|
onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate
|
|
onDeath h u w (f,g) cr
|
|
| _crHP cr > 0 = u w (f,g) cr
|
|
| otherwise = ( ( h cr . f, g ) , Nothing )
|
|
|
|
updateBarrel
|
|
:: World
|
|
-> (World -> World,StdGen)
|
|
-> Creature
|
|
-> ((World -> World , StdGen), Maybe Creature)
|
|
updateBarrel _ (f,g) cr
|
|
| _crHP cr > 0 = ((f, g), newCr)
|
|
| otherwise = ((f, g), Nothing)
|
|
where
|
|
newCr = Just $ doDamage cr
|
|
|
|
-- it is easy to leave off the "f" here
|
|
-- should find some better way of doing all this that is less prone to error
|
|
updateExpBarrel ::
|
|
World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
|
|
updateExpBarrel _ (f,g) cr
|
|
| _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr)
|
|
| otherwise = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing)
|
|
where
|
|
damages = _crDamage $ _crState cr
|
|
pierceSparks :: [World -> World]
|
|
pierceSparks
|
|
= zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
|
|
poss as times colids
|
|
as = randomRs (-0.7,0.7) g
|
|
colids = randomRs (0,11) g
|
|
times = randomRs (2,5) g
|
|
(g',_) = split 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
|
|
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
|
|
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
|
|
|
|
damToExpBarrel :: [DamageType] -> Creature -> Creature
|
|
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
|
|
where
|
|
(pierceDam,otherDam) = partition isPierce ds
|
|
isPierce Piercing{} = True
|
|
isPierce _ = False
|
|
|
|
damToExpBarrel' :: DamageType -> Creature -> Creature
|
|
damToExpBarrel' (Piercing amount _ int _) cr
|
|
= over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr)
|
|
$ over crHP (\hp -> hp - div amount 200) cr
|
|
damToExpBarrel' PoisonDam {} cr = cr
|
|
damToExpBarrel' SparkDam {} cr = cr
|
|
damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
|
|
damToExpBarrel' dt cr = cr Control.Lens.& crHP -~ _dmAmount dt
|