232 lines
7.9 KiB
Haskell
232 lines
7.9 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Dodge.Creature.Update (updateCreature) where
|
|
|
|
import Dodge.Base.You
|
|
import Control.Monad
|
|
import Color
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.List as List
|
|
import Data.Maybe
|
|
import Dodge.Barreloid
|
|
-- import Dodge.Base.NewID
|
|
import Dodge.Corpse.Make
|
|
import Dodge.Creature.Action
|
|
import Dodge.Creature.Radius
|
|
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 Dodge.Update.Camera.Rotate
|
|
import FoldableHelp
|
|
import Geometry
|
|
import LensHelp
|
|
import Linear
|
|
import NewInt
|
|
import RandomHelp
|
|
import SDL (MouseButton (..))
|
|
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 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
|
|
| CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr) . chasmTestCorpse cr
|
|
| null (cr ^? crHP . _HP) = id
|
|
| cr ^. crPos . _z < 0 = (tocr . crZVel -~ 0.5) . (tocr . crPos . _z +~ _crZVel cr)
|
|
| otherwise = updateLivingCreature cr
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
|
|
updateLivingCreature :: Creature -> World -> World
|
|
updateLivingCreature cr =
|
|
chasmTestLiving cr . case _crType cr of
|
|
Avatar{} ->
|
|
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
|
|
. crUpdate cid
|
|
. yourControl cr
|
|
LampCrit{} -> updateLampoid cr
|
|
BarrelCrit bt -> updateBarreloid bt cr
|
|
ChaseCrit{} -> \w ->
|
|
crUpdate cid . performActions cid $
|
|
over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
|
|
AutoCrit {} -> crUpdate cid
|
|
SwarmCrit {} -> crUpdate cid
|
|
HoverCrit {} -> \w ->
|
|
crUpdate cid . performActions cid . hoverCritHoverSound cr $
|
|
over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
|
|
where
|
|
cid = cr ^. crID
|
|
|
|
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 && _crDeathTimer cr > 0 ->
|
|
w
|
|
& tocr . crDamage .~ []
|
|
& tocr . crDeathTimer -~ 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)
|
|
|
|
toDeathCarriage :: Carriage -> Carriage
|
|
toDeathCarriage = \case
|
|
Flying {} -> Falling
|
|
x -> x
|
|
|
|
-- could look at the amount of damage here (given by maxDamage) too
|
|
corpseOrGib :: Creature -> World -> World
|
|
corpseOrGib cr = 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 > 200 ->
|
|
makeCrGibs cr
|
|
. sethp CrIsGibs
|
|
. 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 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
|
|
|
|
chasmTestLiving :: Creature -> World -> World
|
|
chasmTestLiving cr w
|
|
| Flying {} <- cr ^. crStance . carriage = w
|
|
| Falling {} <- cr ^. crStance . carriage =
|
|
w
|
|
-- & tocr . crZVel -~ 0.5
|
|
-- & tocr . crPos . _z +~ _crZVel cr
|
|
| Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
|
|
w
|
|
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
|
|
& tocr . crPos . _xy -~ normalizeV (vNormal (x - y))
|
|
& chasmRotate cr (x - y)
|
|
| any f (w ^. cWorld . chasms) = w & tocr %~ startFalling
|
|
| otherwise = w
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
|
|
f = pointInPoly (cr ^. crPos . _xy)
|
|
|
|
startFalling :: Creature -> Creature
|
|
startFalling cr = case cr ^. crStance . carriage of
|
|
Walking -> cr & crStance . carriage .~ Falling
|
|
_ -> cr & crStance . carriage .~ Falling
|
|
|
|
chasmTestCorpse :: Creature -> World -> World
|
|
chasmTestCorpse cr w
|
|
-- | _crZVel cr < 0 =
|
|
-- w
|
|
-- & tocr . crZVel -~ 0.5
|
|
-- & tocr . crPos . _z +~ _crZVel cr
|
|
-- only look for TWO cliffs to push along
|
|
| (xy:xys) <- filter g (w ^. cWorld . cliffs) =
|
|
w
|
|
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
|
|
& tocr . crPos . _xy +~ h xy xys
|
|
-- | any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
|
|
| any f (w ^. cWorld . chasms) = w & tocr %~ startFalling
|
|
| otherwise = w
|
|
where
|
|
|
|
h :: (Point2,Point2) -> [(Point2,Point2)] -> Point2
|
|
h (x,y) [] = normalizeV (vNormal (x-y))
|
|
h x (y:_) = unitVectorAtAngle $ tweenAngles (d1/(d1+d2)) (h' x) (h' y)
|
|
where
|
|
h' :: (Point2,Point2) -> Float
|
|
h' = argV . vNormal . uncurry (-)
|
|
d a = uncurry closestPointOnLine a (cr ^. crPos . _xy)
|
|
d1 :: Float
|
|
d1 = norm (cxy - d x)
|
|
d2 :: Float
|
|
d2 = norm (cxy - d y)
|
|
cxy = cr ^. crPos . _xy
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
g = uncurry $ circOnSeg cxy (crRad $ cr ^. crType)
|
|
f = pointInPoly cxy
|
|
|
|
chasmRotate :: Creature -> Point2 -> World -> World
|
|
chasmRotate cr v w
|
|
| t = rotateTo8 (argV v) w
|
|
| otherwise = w
|
|
where
|
|
t = cr ^. crID == 0 && null (w ^? input . mouseButtons . ix SDL.ButtonRight)
|
|
|
|
updatePulse :: Pulse -> Pulse
|
|
updatePulse p
|
|
| p ^. pulseProgress >= p ^. pulseRate = p & pulseProgress .~ 0
|
|
| otherwise = p & pulseProgress +~ 1
|