247 lines
7.9 KiB
Haskell
247 lines
7.9 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Creature.Update (updateCreature) where
|
|
|
|
import Dodge.Base.Collide
|
|
import Dodge.Creature.Radius
|
|
import Color
|
|
import Control.Monad
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Data.Maybe
|
|
import Dodge.Barreloid
|
|
import Dodge.Base.You
|
|
-- import Dodge.Base.NewID
|
|
import Dodge.Creature.Action
|
|
import Dodge.Creature.Picture
|
|
import Dodge.Creature.State
|
|
import Dodge.Creature.State.WalkCycle
|
|
import Dodge.Creature.Vocalization
|
|
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 Dodge.Prop.Gib
|
|
import Dodge.SoundLogic
|
|
import FoldableHelp
|
|
import Geometry
|
|
import LensHelp
|
|
import Linear
|
|
import NewInt
|
|
import qualified Quaternion as Q
|
|
import RandomHelp
|
|
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
|
|
| cr ^. crPos . _z < negate 300 = (tocr . crHP .~ CrDestroyed Pitted) . destroyAllInvItems cr
|
|
| CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr)
|
|
| null (cr ^? crHP . _HP) = id
|
|
| otherwise = updateLivingCreature cr
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
|
|
updateLivingCreature :: Creature -> World -> World
|
|
updateLivingCreature cr = case _crType cr of
|
|
Avatar{} ->
|
|
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
|
|
. crUpdate cid
|
|
. yourControl
|
|
LampCrit{} -> updateLampoid cr
|
|
BarrelCrit bt -> updateBarreloid bt cr
|
|
ChaseCrit{} -> \w ->
|
|
crUpdate cid . performActions cid $
|
|
over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
|
|
CrabCrit{} ->
|
|
crUpdate cid . performActions cid . crabCritInternal cid
|
|
AutoCrit{} -> crUpdate cid
|
|
SwarmCrit{} -> crUpdate cid
|
|
HoverCrit{} -> \w ->
|
|
crUpdate cid . performActions cid . hoverCritHoverSound cr $
|
|
over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
|
|
SlinkCrit{} -> slinkCritUpdate cid
|
|
SlimeCrit{} -> slimeCritUpdate cid
|
|
where
|
|
cid = cr ^. crID
|
|
|
|
slimeCritUpdate :: Int -> World -> World
|
|
slimeCritUpdate cid w = w
|
|
& cWorld . lWorld . creatures . ix cid .~ mvslime
|
|
where
|
|
txy = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
|
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
|
cxy = cr ^. crPos . _xy
|
|
mvslime
|
|
| hasLOS cxy txy w = mvslime'
|
|
| otherwise = cr
|
|
mvslime' = cr & crType . slimeCompression .~ p' + x
|
|
& crPos . _xy +~ g (0.5*x)
|
|
& crType . slimeIsCompressing %~ (f . f')
|
|
& crDir .~ argV (txy-cxy)
|
|
g | cr ^?! crType . slimeIsCompressing = negate
|
|
| otherwise = id
|
|
s | cr ^?! crType . slimeIsCompressing = 2/3
|
|
| otherwise = 1.5
|
|
f | abs (norm v - norm p') < 0.1 = not
|
|
| otherwise = id
|
|
v = (s * r) *^ unitVectorAtAngle (cr ^. crDir)
|
|
r = crRad (cr ^. crType)
|
|
p = cr ^?! crType . slimeCompression
|
|
(p',f')
|
|
| dot p v > 0 && dot p v > dot p (vNormal v) && dot p v > dot p (-vNormal v) = (p, id)
|
|
| dot p (-v) > dot p (vNormal v) && dot p (-v) > dot p (-vNormal v) = (-p, id)
|
|
| dot p (vNormal v) > dot p (-vNormal v) = ((r*r/norm p) *^ normalize (vNormal p), not)
|
|
| otherwise = (-(r*r/norm p) *^ normalize (vNormal p), not)
|
|
x = 0.1 *^ normalize (v - p')
|
|
|
|
slinkCritUpdate :: Int -> World -> World
|
|
slinkCritUpdate cid w =
|
|
w
|
|
& cWorld
|
|
. lWorld
|
|
. creatures
|
|
. ix cid
|
|
. crType
|
|
. slinkSpine
|
|
. each
|
|
. _2
|
|
*~ Q.axisAngle (V3 0 1 0) (pi / 1000)
|
|
|
|
-- spineWalk :: [Point3Q]
|
|
-- spineWalk = replicate 15 (V3
|
|
|
|
hoverCritHoverSound :: Creature -> World -> World
|
|
hoverCritHoverSound cr w = fromMaybe w $ do
|
|
guard $ d < 100
|
|
return $
|
|
soundContinueVol
|
|
(0.5 * (1 - 0.01 * d))
|
|
(CrSound cid)
|
|
cxy
|
|
buzz1S
|
|
(Just 2)
|
|
w
|
|
where
|
|
cxy = cr ^. crPos . _xy
|
|
d = max 0 (dist (you w ^. crPos . _xy) cxy - 100)
|
|
cid = cr ^. crID
|
|
|
|
{- | 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 :: Int -> World -> World
|
|
crUpdate cid =
|
|
checkDeath cid
|
|
. doDamage cid
|
|
. invItemEffs cid
|
|
. updateCarriage cid -- stride appears to be updated elsewhere as well
|
|
|
|
checkDeath :: Int -> World -> World
|
|
checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
|
|
|
|
checkDeath' :: Creature -> World -> World
|
|
checkDeath' cr w = case cr ^. crHP of
|
|
HP x | x > 0 -> w & tocr . crDamage .~ []
|
|
HP x
|
|
| x > -200 && null (cr ^. crDeathTimer) ->
|
|
w & tocr %~ startDeathTimer
|
|
HP x
|
|
| x > -200
|
|
, Just y <- cr ^. crDeathTimer
|
|
, y > 0 ->
|
|
w
|
|
& tocr
|
|
. crDamage
|
|
.~ []
|
|
& tocr
|
|
. crDeathTimer
|
|
. _Just
|
|
-~ 1
|
|
HP _ ->
|
|
w
|
|
& dropAll cr -- the order of these is possibly important
|
|
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
|
& corpseOrGib cr
|
|
& tocr
|
|
. crStance
|
|
. carriage
|
|
%~ toDeathCarriage
|
|
_ -> w
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
|
|
startDeathTimer :: Creature -> Creature
|
|
startDeathTimer cr =
|
|
cr
|
|
& crDeathTimer
|
|
?~ case cr ^. crType of
|
|
HoverCrit{} -> 0
|
|
_ -> 5
|
|
|
|
toDeathCarriage :: Carriage -> Carriage
|
|
toDeathCarriage = \case
|
|
Flying{} -> Falling Q.qid Q.qid
|
|
Walking -> OnGround Q.qid
|
|
_ -> Falling Q.qid Q.qid
|
|
|
|
-- could look at the amount of damage here (given by maxDamage) too
|
|
corpseOrGib :: Creature -> World -> World
|
|
corpseOrGib cr w =
|
|
w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
|
|
Just CookingDamage ->
|
|
sethp (CrIsCorpse $ scorchSPic thecorpse)
|
|
. dodeathsound CookDeath
|
|
Just PoisonDamage ->
|
|
sethp (CrIsCorpse $ poisonSPic thecorpse)
|
|
. dodeathsound PoisonDeath
|
|
Just PhysicalDamage
|
|
| _crPain cr > 300 ->
|
|
makeCrGibs cr
|
|
. sethp (CrDestroyed Gibbed)
|
|
. dodeathsound GibsDeath
|
|
_ ->
|
|
sethp (CrIsCorpse thecorpse)
|
|
. dodeathsound PlainDeath
|
|
where
|
|
dodeathsound dt = f dt . stopSoundFrom (CrMouth cid)
|
|
f dt w' = fromMaybe w' $ do
|
|
let (msid, g) = runState (maybeTakeOne (crDeathSounds cr dt)) (_randGen w')
|
|
sid <- msid
|
|
return $
|
|
w'
|
|
& soundStart (CrMouth cid) (cr ^. crPos . _xy) sid Nothing
|
|
& randGen
|
|
.~ g
|
|
cid = cr ^. crID
|
|
sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
|
|
thecorpse = makeCorpse (w ^. randGen) 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 . _unNIntMap $ _crInv cr
|
|
|
|
-- startFalling :: Creature -> Creature
|
|
-- startFalling cr = case cr ^. crStance . carriage of
|
|
-- Walking -> cr & crStance . carriage .~ Falling
|
|
-- _ -> cr & crStance . carriage .~ Falling
|
|
|
|
updatePulse :: Pulse -> Pulse
|
|
updatePulse p
|
|
| p ^. pulseProgress >= p ^. pulseRate = p & pulseProgress .~ 0
|
|
| otherwise = p & pulseProgress +~ 1
|