622 lines
25 KiB
Haskell
622 lines
25 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Creature.Update (updateCreature) where
|
|
|
|
import qualified Data.Semigroup as Semi
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import Dodge.Humanoid
|
|
import Dodge.Creature.Perception
|
|
import Dodge.Creature.ReaderUpdate
|
|
import Dodge.Creature.Slime
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Creature.MoveType
|
|
import Dodge.Base.Collide
|
|
import Data.List (sortOn)
|
|
import Dodge.Zoning.Creature
|
|
import Dodge.Creature.ChaseCrit
|
|
import Dodge.Creature.Damage
|
|
import Color
|
|
import Control.Monad
|
|
import qualified IntMapHelp as IM
|
|
import Data.Maybe
|
|
import Dodge.Barreloid
|
|
import Dodge.Base.You
|
|
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.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
|
|
import qualified Data.IntSet as IS
|
|
|
|
-- 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 = (cWorld . lWorld . creatures . at (cr ^. crID) %~ destroyCreature)
|
|
. destroyAllInvItems cr
|
|
| otherwise = case cr ^. crHP of
|
|
CrIsCorpse{} -> cleardamage . updateCarriage (_crID cr) . applyCreatureDamage (_crID cr) cr
|
|
AvatarDestroyed{} -> id
|
|
HP{} -> cleardamage . updateLivingCreature cr
|
|
where
|
|
cleardamage = cWorld . lWorld . creatures . ix (cr^.crID) . crDamage .~ mempty
|
|
|
|
updateLivingCreature :: Creature -> World -> World
|
|
updateLivingCreature cr = case cr ^. crType of
|
|
Avatar{} ->
|
|
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
|
|
. crUpdate cid
|
|
. yourControl
|
|
LampCrit{} -> updateLampoid cr
|
|
BarrelCrit bt -> updateBarreloid bt cr
|
|
ChaseCrit{} -> crUpdate cid . performActions cid . setChaseCritKinematics cid . updateChaseCrit cid cr
|
|
CrabCrit{} -> crUpdate cid . performActions cid . crabCritInternal cid
|
|
AutoCrit{} -> crUpdate cid
|
|
SwarmCrit{} -> crUpdate cid
|
|
HoverCrit{} -> crUpdate cid . performActions cid . hoverCritHoverSound cr .
|
|
updateHoverCrit cid
|
|
SlinkCrit{} -> slinkCritUpdate cid
|
|
SlimeCrit{} -> updateSlimeCrit cid
|
|
BeeCrit{} -> crUpdate cid . performActions cid . updateBeeFromPheremones cr cid . updateBeeCrit cr cid
|
|
HiveCrit{} -> crUpdate cid . performActions cid . updateHiveCrit cr cid
|
|
where
|
|
cid = cr ^. crID
|
|
|
|
updateHiveCrit :: Creature -> Int -> World -> World
|
|
updateHiveCrit cr cid w
|
|
| Just x <- cr ^? crType . hiveChildren . to IS.size
|
|
, x < nbees
|
|
, Just y <- cr ^? crType . hiveGestation
|
|
, y == 0
|
|
, Just z <- cr ^? crType . hiveSlime
|
|
, z >= 400
|
|
= w
|
|
& tocr . crType . hiveChildren %~ IS.insert nid
|
|
& tocr . crType . hiveGestation .~ 50
|
|
& cWorld . lWorld . creatures . at nid ?~ ncr
|
|
& tocr . crType . hiveSlime -~ 400
|
|
| Just x <- cr ^? crType . hiveChildren . to IS.size
|
|
, x < nbees = w
|
|
& tocr . crType . hiveGestation %~ (max 0 . subtract 1)
|
|
| otherwise = w
|
|
where
|
|
nbees = 15
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
nid = IM.newKey $ w ^. cWorld . lWorld . creatures
|
|
ncr = beeCrit & crPos .~ (cr ^. crPos + (0 & _xy +~ 25))
|
|
& crID .~ nid
|
|
& crType . beeHive ?~ cid
|
|
|
|
updateBeeFromPheremones :: Creature -> Int -> World -> World
|
|
updateBeeFromPheremones cr cid w
|
|
| any f (w ^. cWorld . lWorld . beePheremones) = w
|
|
& cWorld . lWorld . creatures . ix cid . crType . beeAggro .~ 300
|
|
| otherwise = w
|
|
where
|
|
f bp = distance (cr ^. crPos . _xy) (bp ^. bpPos . _xy) < 20
|
|
|
|
updateBeeCrit :: Creature -> Int -> World -> World
|
|
updateBeeCrit cr cid
|
|
| cr ^?! crType . beeAggro > 0 = updateAggroBee cr cid
|
|
| otherwise = beeLifespanCheck cr cid . updateCalmBee cr cid
|
|
|
|
beeLifespanCheck :: Creature -> Int -> World -> World
|
|
beeLifespanCheck cr cid
|
|
| Just ls <- cr ^? crType . beeLifespan
|
|
, Just x <- cr ^? crType . beeSlime
|
|
, ls < 1
|
|
, x < 5
|
|
= cWorld . lWorld . creatures . ix cid . crHP . _HP -~ 1
|
|
| otherwise = id
|
|
|
|
updateAggroBee :: Creature -> Int -> World -> World
|
|
updateAggroBee cr cid w
|
|
| Mounted{} <- cr ^. crStance . carriage = w & tocr . crStance . carriage .~ Flying 0
|
|
| Just tcr <- atarget
|
|
, distance (tcr ^. crPos . _xy) (cr ^. crPos . _xy) < crRad (cr ^. crType) + crRad (tcr ^. crType) + 1
|
|
, nearZeroAngle (argV (tcr ^. crPos . _xy - cr ^. crPos . _xy) - cr ^. crDir) < pi / 2
|
|
, 0 <- cr ^?! crType . meleeCooldown
|
|
= w & tocr . crPos .~ (cr ^. crOldPos & _xy -~ 5 *^ unitVectorAtAngle (cr ^. crDir))
|
|
& tocr . crType . startStopMv .~ (cr ^?! to crMvType . mvPulseTime)
|
|
& cWorld . lWorld . creatures . ix (tcr ^. crID) . crDamage
|
|
.:~ Blunt 50 (cxy + crRad (cr ^. crType) *^ vdir) vdir (CrMeleeO (cr ^. crID))
|
|
& tocr . crType . meleeCooldown .~ 20
|
|
| Just tcr <- atarget = w & tocr . crActionPlan . apStrategy .~ CloseToMelee (tcr ^. crID)
|
|
& tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
|
|
& tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
|
|
| Just PathTo{} <- cr ^? crActionPlan . apAction = w & tocr . crType . beeAggro -~ 1
|
|
& tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
|
|
| otherwise = w & tocr . crType . beeAggro -~ 1
|
|
& tocr . crActionPlan . apAction .~ PathTo (cxy + p) NoAction
|
|
& tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
|
|
& randGen .~ g
|
|
where
|
|
(p,g) = runState (randOnCirc 150) (w ^. randGen)
|
|
atarget = listToMaybe . sortOn (distance cxy . (^.crPos._xy)) . IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w
|
|
vdir = unitVectorAtAngle (cr ^. crDir)
|
|
cxy = cr ^. crPos . _xy
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
istarget tcr = t (tcr ^. crType)
|
|
&& isJust (tcr ^? crHP . _HP)
|
|
&& hasLOS cxy (tcr ^. crPos . _xy) w
|
|
t = \case
|
|
Avatar{} -> True
|
|
ChaseCrit{} -> True
|
|
CrabCrit{} -> True
|
|
_ -> False
|
|
|
|
-- do bees need to be able to see slime targets?
|
|
-- if no path can be made, reset harvest action
|
|
-- this should all be simplified
|
|
-- should count how many are mounted on an individual slime, try for a different
|
|
-- slime if too many
|
|
updateCalmBee :: Creature -> Int -> World -> World
|
|
updateCalmBee cr cid w
|
|
| Just hcr <- gethive
|
|
, distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30
|
|
, Just x <- cr ^? crType . beeSlime
|
|
, x >= 50 = w
|
|
& tocr . crType . beeSlime -~ 50
|
|
& cWorld . lWorld . creatures . ix (hcr ^. crID) . crType . hiveSlime +~ 50
|
|
| Just x <- cr ^? crType . beeSlime
|
|
, x < 50
|
|
, Just hcr <- gethive
|
|
, distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30
|
|
, Just ReturnToHive <- cr ^? crActionPlan . apStrategy = startsearch
|
|
| Just ReturnToHive <- cr ^? crActionPlan . apStrategy = w
|
|
| Just x <- cr ^? crType . beeSlime
|
|
, x >= 1500 = starthivereturn
|
|
& randGen .~ gsa
|
|
& tocr . crType . beeLifespan %~ max 0 . subtract sa
|
|
| Just mid <- cr ^? crStance . carriage . mountID
|
|
, mountshakeoff mid = startsearch
|
|
| Nothing <- cr ^? crActionPlan . apStrategy . harvestTarget
|
|
, xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w
|
|
, (tcr,g') <- runState (takeOne xs) (w ^. randGen) =
|
|
w & tocr . crActionPlan . apStrategy .~ HarvestFrom (tcr ^. crID)
|
|
& randGen .~ g'
|
|
| Just tid <- cr ^? crStance . carriage . mountID
|
|
, Just SlimeCrit{} <- w ^? cWorld . lWorld . creatures . ix tid . crType = w
|
|
& tocr . crType . beeSlime +~ sspeed
|
|
& cWorld . lWorld . creatures . ix tid . crType . slimeSlime -~ sspeed
|
|
| Just (tcr,ti) <- gettarg
|
|
, distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.8*crRad (tcr ^. crType)
|
|
, Just d <- tcr ^? crType . slimeCompression
|
|
= w
|
|
& tocr . crStance . carriage .~ Mounted ti
|
|
(oxyrot (tcr^.crDir)
|
|
(oxyrot (-tcr^.crDir) (cr ^. crPos - tcr ^. crPos) & _x %~ (/d) & _y *~ d))
|
|
& tocr . crActionPlan . apAction .~ NoAction
|
|
| Just (tcr,_) <- gettarg = w
|
|
& tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
|
|
| Just (HarvestFrom{}) <- cr ^? crActionPlan . apStrategy = startsearch
|
|
| Just (SearchTimed 0) <- cr ^? crActionPlan . apStrategy = starthivereturn
|
|
| Just PathTo{} <- cr ^? crActionPlan . apAction = w
|
|
& tocr . crActionPlan . apStrategy . searchTimer %~ (max 0 . subtract 1)
|
|
| otherwise = startsearch
|
|
where
|
|
oxyrot a = over _xy (rotateV a)
|
|
(sa,gsa) = runState (takeOne [0,1]) (w ^. randGen)
|
|
starthivereturn = fromMaybe w $ do
|
|
hcr <- gethive
|
|
return $ w
|
|
& tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
|
|
& tocr . crActionPlan . apStrategy .~ ReturnToHive
|
|
& tocr . crStance . carriage %~ dounmount
|
|
dounmount x = case x of
|
|
Flying{} -> x
|
|
_ -> Flying 0
|
|
startsearch = w
|
|
& tocr . crActionPlan . apAction .~ PathTo (cxy + p) NoAction
|
|
& tocr . crStance . carriage %~ dounmount
|
|
& randGen .~ g
|
|
& tocr . crActionPlan . apStrategy .~ SearchTimed 200
|
|
(p,g) = runState (randOnCirc 200) (w ^. randGen)
|
|
cxy = cr ^. crPos . _xy
|
|
mountshakeoff mid = fromMaybe False $ do
|
|
mcr <- w ^? cWorld . lWorld . creatures . ix mid
|
|
x <- mcr ^? crType . slimeDistortion . sdTime
|
|
return $ x > 8
|
|
sspeed = 5
|
|
gettarg = do
|
|
i <- cr ^? crActionPlan . apStrategy . harvestTarget
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix i
|
|
x <- tcr ^? crType . slimeSlime . to slimeToRad
|
|
guard $ x > 12
|
|
return (tcr,i)
|
|
gethive = do
|
|
i <- cr ^? crType . beeHive . _Just
|
|
w ^? cWorld . lWorld . creatures . ix i
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
istarget tcr = fromMaybe False $ do
|
|
r <- tcr ^? crType . slimeSlime . to slimeToRad
|
|
return $ r > 12
|
|
|
|
updateSlimeCrit :: Int -> World -> World
|
|
updateSlimeCrit cid w
|
|
| cr ^?! crType . slimeSlime < 2500
|
|
= w & cWorld . lWorld . creatures . at cid .~ Nothing
|
|
| Just hitp <- w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmPos
|
|
, Just hitv <- w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmVector
|
|
, Just w' <- splitSlimeCrit' hitp hitv cid cr w = w'
|
|
| (cr ^?! crType . slimeIsCompressing) && 1 > p
|
|
= let (w',g) = runState (setSlimeDir cid cr w) (w ^. randGen)
|
|
in w' & randGen .~ g
|
|
| otherwise = updateCarriage cid $ w
|
|
& cWorld . lWorld . creatures . ix cid %~ mvslime
|
|
& cWorld . lWorld . creatures . ix cid . crDamage .~ []
|
|
& tocr %~ doSlimeRadChange
|
|
& tocr . crType . slimeDistortion %~ fsst
|
|
& tocr . crType . slimeEngulfProgress %~ (max 0 . subtract 0.5)
|
|
where
|
|
fsst (SlimeDistortion x ps t) | x > 0 = SlimeDistortion (x-1) ps t
|
|
fsst _ = NoSlimeDistortion
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
|
mvslime cr' = cr' & crType . slimeCompression +~ f (0.1/r)
|
|
& crPos . _xy +~ 0.1 *^ unitVectorAtAngle (cr' ^. crDir)
|
|
& crType . slimeIsCompressing %~ f'
|
|
f | cr ^?! crType . slimeIsCompressing = negate
|
|
| otherwise = id
|
|
f' | p > 1.5 = const True
|
|
| otherwise = id
|
|
r = cr ^?! crType . slimeSlime . to slimeToRad
|
|
p = cr ^?! crType . slimeCompression
|
|
|
|
setSlimeDir :: Int -> Creature -> World -> State StdGen World
|
|
setSlimeDir cid cr w = do
|
|
i <- state $ randomR (0,1)
|
|
d <- state $ randomR (0,2*pi)
|
|
if i < (r - 11) / 50
|
|
then do
|
|
x <- randInCirc 1
|
|
return $ fromMaybe w $ splitSlimeCrit' (x + cxy) (unitVectorAtAngle d) cid cr w
|
|
else return $ w & tocr . crDir .~ d
|
|
& tocr . crType . slimeIsCompressing .~ False
|
|
& tocr . crDamage .~ mempty
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
cxy = cr ^. crPos . _xy
|
|
r = cr ^?! crType . slimeSlime . to slimeToRad
|
|
|
|
doSlimeRadChange :: Creature -> Creature
|
|
doSlimeRadChange = crType . slimeSlimeChange %~ f
|
|
where
|
|
f x | x > 1000 = x - 1000
|
|
| x < -1000 = x + 1000
|
|
| otherwise = 0
|
|
|
|
splitSlimeCrit' :: Point2 -> Point2 -> Int -> Creature -> World -> Maybe World
|
|
splitSlimeCrit' p v cid cr w = do
|
|
(cr1,cr2) <- splitSlimeCrit p v cr
|
|
let cid' = IM.newKey $ w ^. cWorld . lWorld . creatures
|
|
(s,g) = runState (takeOne [popS,pop1S,pop2S,pop3S]) (w ^. randGen)
|
|
return $ w & cWorld . lWorld . creatures . ix cid .~ cr1
|
|
& cWorld . lWorld . creatures . at cid' ?~ (cr2 & crID .~ cid')
|
|
& soundStart (CrSound cid) (cr ^. crPos . _xy) s Nothing
|
|
& randGen .~ g
|
|
|
|
splitSlimeCrit :: Point2 -> Point2 -> Creature -> Maybe (Creature, Creature)
|
|
splitSlimeCrit p v cr = do
|
|
let mp = closestPointOnLine p (p+v) cxy
|
|
h = r - distance mp cxy
|
|
guard $ h > 0
|
|
let a1 = segmentArea r h
|
|
a2 = pi*r*r - a1
|
|
r1 = sqrt (a1/pi)
|
|
r2 = sqrt (a2/pi)
|
|
mvdir
|
|
| isLHS p (p+v) cxy = normalize (vNormal v)
|
|
| otherwise = - normalize (vNormal v)
|
|
(ps',qs')
|
|
| isLHS p (p+v) cxy = (ps,qs)
|
|
| otherwise = (qs,ps)
|
|
c1 = cr' & crPos . _xy .~ mp + r1 *^ mvdir
|
|
& crType . slimeSlime .~ round (r1 ^ (2 :: Int) * 100)
|
|
& crDir .~ argV mvdir
|
|
c2 = cr' & crPos . _xy .~ mp - r2 *^ mvdir
|
|
& crType . slimeSlime .~ round (r2^(2::Int) * 100)
|
|
& crDir .~ argV (-mvdir)
|
|
c1ps = qs' & each +~ cxy - (mp + r1 *^ mvdir) & each %~ rotateV (- c1 ^. crDir)
|
|
c2ps = ps' & each +~ cxy - (mp - r2 *^ mvdir) & each %~ rotateV (- c2 ^. crDir)
|
|
return (c1 & crType . slimeDistortion . sdShape .~ f c1ps c1
|
|
,c2 & crType . slimeDistortion . sdShape .~ f c2ps c2
|
|
)
|
|
where
|
|
f xs@(_:_) c = polyInPoly (centroid xs) xs (slimeOutline c)
|
|
f _ _ = mempty
|
|
cxy = cr ^. crPos . _xy
|
|
r = cr ^?! crType . slimeSlime . to slimeToRad
|
|
cr' = cr & crDamage .~ []
|
|
& crType . slimeSlimeChange .~ 0
|
|
& crType . slimeDistortion .~ SlimeDistortion 10 mempty True
|
|
& crType . slimeIsCompressing .~ False
|
|
& crType . slimeCompression .~ 1
|
|
(ps,qs) = cutPoly (p-cxy) (p+v-cxy) $ slimeOutline cr & each %~ rotateV (cr ^. crDir)
|
|
|
|
-- h is the height of the segment, ie r - distance to center
|
|
segmentArea :: Float -> Float -> Float
|
|
segmentArea r h = r*r*acos(1-h/r) - (r-h)*sqrt(h*(2*r-h))
|
|
|
|
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)
|
|
|
|
setChaseCritKinematics :: Int -> World -> World
|
|
setChaseCritKinematics cid w = w
|
|
& cWorld . lWorld . creatures . ix cid %~ setChaseCritKinematics' w
|
|
|
|
ccAngles :: World -> Creature -> (Float,Float,Float,Float)
|
|
ccAngles w cr
|
|
| Eat i _ <- cr^?!crActionPlan.apAction = fromMaybe (0,0,0,0) $ do
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix i
|
|
let tp = tcr ^. crPos + V3 0 0 (crMid tcr)
|
|
(np,_) = (cr ^. crPos, Q.qz (cr ^. crDir))
|
|
`Q.comp` (V3 8 0 14, Q.qid)
|
|
v = tp - np
|
|
a = angleVV3 v (v & _z .~ 0)
|
|
return $ f (-a) 0 0
|
|
| CloseToMelee i<-cr^?!crActionPlan.apStrategy = fromMaybe (0,0,0,0) $ do
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix i
|
|
let tp = tcr ^. crPos + V3 0 0 (crMid tcr)
|
|
(np,_) = (cr ^. crPos, Q.qz (cr ^. crDir))
|
|
`Q.comp` (V3 8 0 14, Q.qid)
|
|
v = tp - np
|
|
a = angleVV3 v (v & _z .~ 0)
|
|
return $ f
|
|
(0.45*pi - a)
|
|
(-0.9*pi)
|
|
(0.45*pi)
|
|
| otherwise = f (0.6*pi) (-0.2*pi) (-0.4*pi)
|
|
where
|
|
f a b c = (0,a,b,c)
|
|
|
|
ccKState :: World -> Creature -> ChaseKState
|
|
ccKState _ cr
|
|
| Eat i _ <- cr^?!crActionPlan.apAction = PeckingCK i
|
|
| CloseToMelee i <- cr^?!crActionPlan.apStrategy = AimingCK i
|
|
| otherwise = UprightCK
|
|
|
|
setChaseCritKinematics' :: World -> Creature -> Creature
|
|
setChaseCritKinematics' w = f . g
|
|
where
|
|
g cr | ccKState w cr == cr ^?! crType . chaseKState = cr
|
|
| PeckingCK i <- ccKState w cr = cr
|
|
& crType . chaseLerp .~ 3
|
|
& crType . chaseKState .~ PeckingCK i
|
|
| otherwise = cr & crType . chaseLerp .~ 20
|
|
& crType . chaseKState .~ ccKState w cr
|
|
f cr =
|
|
let (a,b,c,d) = ccAngles w cr
|
|
x = cr ^?! crType . chaseLerp
|
|
in if x <= 1
|
|
then cr & crType . chaseqy0 .~ a
|
|
& crType . chaseqy1 .~ b
|
|
& crType . chaseqy2 .~ c
|
|
& crType . chaseqy3 .~ d
|
|
else cr
|
|
& crType . chaseqy0 %~ h x a
|
|
& crType . chaseqy1 %~ h x b
|
|
& crType . chaseqy2 %~ h x c
|
|
& crType . chaseqy3 %~ h x d
|
|
& crType . chaseLerp -~ 1
|
|
h x a b = 1/fromIntegral x * a + (1-1/fromIntegral x) * b
|
|
|
|
updateChaseCrit :: Int -> Creature -> World -> World
|
|
updateChaseCrit cid cr
|
|
| SearchForFood <- cr ^?! crActionPlan . apGoal = updateFoodSearchChaseCrit cid cr
|
|
| Flee <- cr^?!crActionPlan.apGoal
|
|
, NoAction <- cr^?!crActionPlan.apAction = tocr.crActionPlan.apGoal.~SearchForFood
|
|
| Flee <- cr^?!crActionPlan.apGoal = id
|
|
| otherwise = updateCalmChaseCrit cid
|
|
where
|
|
tocr = cWorld.lWorld.creatures.ix cid
|
|
|
|
updateFoodSearchChaseCrit :: Int -> Creature -> World -> World
|
|
updateFoodSearchChaseCrit cid cr w
|
|
| (tcr:_) <- sortOn f . IM.elems . IM.filter avoidcr $ crsNearCirc cxy 60 w
|
|
= let p = fleePoint cr cxy (20 *^ normalize (cxy - tcr^.crPos._xy)) w
|
|
in w &tocr.crActionPlan.apAction.~PathTo p NoAction
|
|
&tocr.crActionPlan.apGoal.~Flee
|
|
| Eat i 0 <- cr^?! crActionPlan.apAction = w
|
|
& cWorld .lWorld.creatures . at i .~ Nothing
|
|
& tocr . crActionPlan.apAction.~NoAction
|
|
& tocr . crActionPlan.apStrategy.~Search
|
|
| Eat i x <- cr^?! crActionPlan.apAction = w
|
|
& tocr .crActionPlan.apAction.acTimer-~1
|
|
| CloseToMelee i<-cr^?!crActionPlan.apStrategy
|
|
,Nothing <- w ^?cWorld.lWorld.creatures.ix i = w & tocr . crActionPlan.apStrategy .~ Search
|
|
| CloseToMelee i<-cr^?!crActionPlan.apStrategy
|
|
,Just tcr <-w^?cWorld.lWorld.creatures.ix i
|
|
,distance cxy (tcr^.crPos._xy) < 15 = w
|
|
& tocr.crActionPlan.apAction.~Eat i 5
|
|
-- & tocr.crActionPlan.apAction.~NoAction
|
|
-- & tocr.crActionPlan.apStrategy.~Search
|
|
-- & cWorld.lWorld.creatures.at i.~Nothing
|
|
| CloseToMelee{}<-cr^?!crActionPlan.apStrategy
|
|
,PathTo{}<-cr^?!crActionPlan.apAction= w
|
|
| xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w
|
|
, (tcr,g) <- runState (takeOne xs) (w ^. randGen) = w&tocr.crActionPlan.apAction.~DoImpulses[MvForward]
|
|
&tocr.crActionPlan.apStrategy.~CloseToMelee (tcr^.crID)
|
|
&tocr.crActionPlan.apAction.~PathTo (tcr^.crPos._xy) NoAction
|
|
&randGen.~g
|
|
| otherwise = w
|
|
where
|
|
f c = fromMaybe 100 $ do
|
|
s <- cr^?crType.slimeSlime
|
|
return $ dist cxy (c^.crPos._xy) - sqrt(0.01*fromIntegral s)
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
cxy = cr ^. crPos . _xy
|
|
avoidcr c | ct@SlimeCrit{} <- c^.crType = distance cxy (c^.crPos._xy)-crRad ct < 10
|
|
| otherwise = False
|
|
istarget tcr
|
|
| BeeCrit{} <- tcr^.crType
|
|
, CrIsCorpse{} <- tcr^.crHP = True
|
|
| otherwise = False
|
|
|
|
fleePoint :: Creature -> Point2 -> Point2 -> World -> Point2
|
|
fleePoint c p v w = g . minimum $ f <$> [p+v, p+0.9*^vNormal v, p-0.9*^vNormal v]
|
|
where
|
|
f ep = let q = walkablePoint c p ep w
|
|
in Semi.Arg (-distance q p) q
|
|
g (Semi.Arg _ x) = x
|
|
|
|
|
|
updateCalmChaseCrit :: Int -> World -> World
|
|
updateCalmChaseCrit cid w = w
|
|
& tocr %~ overrideMeleeCloseTarget w
|
|
& tocr %~ setViewPos w
|
|
& tocr %~ setMvPosToTargetCr w
|
|
& tocr %~ chaseCritMv w
|
|
& tocr %~ perceptionUpdate [0] w
|
|
& tocr %~ targetYouWhenCognizant w
|
|
& tocr %~ searchIfDamaged
|
|
& tocr . crType . meleeCooldown %~ max 0 . subtract 1
|
|
& tocr . crVocalization %~ updateVocTimer
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix cid
|
|
|
|
|
|
hoverCritHoverSound :: Creature -> World -> World
|
|
hoverCritHoverSound cr w
|
|
| d < 100
|
|
= soundContinueVol (0.5 * (1 - 0.01 * d)) (CrSound cid) cxy buzz1S (Just 2) w
|
|
| otherwise = 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
|
|
HP x | x > -200 && null (cr ^. crDeathTimer) -> w & tocr %~ startDeathTimer
|
|
HP x
|
|
| x > -200
|
|
, Just y <- cr ^. crDeathTimer
|
|
, y > 0 -> w & tocr . crDeathTimer . _Just -~ 1
|
|
HP _ ->
|
|
w
|
|
& dropAll cr -- the order of these is possibly important
|
|
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
|
|
& corpseOrGib cr
|
|
& crDeathEffects cr
|
|
& tocr . crStance . carriage %~ toDeathCarriage
|
|
_ -> w
|
|
where
|
|
tocr = cWorld . lWorld . creatures . ix (_crID cr)
|
|
|
|
crDeathEffects :: Creature -> World -> World
|
|
crDeathEffects cr w = case cr ^. crType of
|
|
BeeCrit {_beeHive = mhid} -> beepheremone $ fromMaybe w $ do
|
|
hid <- mhid
|
|
return $ w & cWorld . lWorld . creatures . ix hid . crType . hiveChildren %~ IS.delete (cr ^. crID)
|
|
_ -> w
|
|
where
|
|
beepheremone
|
|
| Just x <- cr ^? crType . beeLifespan
|
|
, x < 1 = id
|
|
| otherwise = cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos) (cr ^. crPos - cr ^. crOldPos) 200
|
|
|
|
startDeathTimer :: Creature -> Creature
|
|
startDeathTimer cr = cr & crDeathTimer ?~ case cr ^. crType of
|
|
HoverCrit{} -> 0
|
|
BeeCrit{} -> 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
|
|
. (cWorld . lWorld . creatures . at (cr ^. crID) %~ destroyCreature)
|
|
. 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 (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
|
|
|
|
updatePulse :: Pulse -> Pulse
|
|
updatePulse p
|
|
| p ^. pulseProgress >= p ^. pulseRate = p & pulseProgress .~ 0
|
|
| otherwise = p & pulseProgress +~ 1
|