Files
loop/src/Dodge/Creature/Impulse.hs
T
2026-03-31 22:50:53 +01:00

76 lines
2.9 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
--{-# LANGUAGE TupleSections #-}
module Dodge.Creature.Impulse (followImpulse) where
import Control.Monad.Trans.State.Lazy
--import Control.Monad.State -- moving from mtl to transformers
import Data.Maybe
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.MoveType
--import Dodge.Creature.Impulse.UseItem
import Dodge.Creature.Vocalization
import Dodge.CreatureEffect
import Dodge.Data.World
import Dodge.FloatFunction
import Dodge.RandImpulse
import Dodge.SoundLogic
import Geometry
import LensHelp
import Linear
import System.Random
-- note SwitchToItem doesn't necessarily update the root item correctly
followImpulse :: Int -> World -> Impulse -> World
followImpulse cid w = \case
ImpulseNothing -> w
RandomImpulse rimp ->
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
in randGen .~ newgen $ followImpulse cid w newimp
Bark sid ->
soundStart (CrMouth cid) cpos sid Nothing $
w & clens %~ resetCrVocCoolDown w
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld)
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld)
MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld)
Turn a -> crup $ crDir +~ a
TurnToward p a -> crup $ creatureTurnToward p a
TurnTo p -> crup $ creatureTurnTo p
ChangePosture post -> crup $ crStance . posture .~ post
UseItem -> undefined
-- SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
Melee cid' ->
hitCr cid' $
crup
( crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) . (crType . meleeCooldown .~ 20)
)
RandomTurn a ->
let (aa, g) = rr a
in (randGen .~ g) (crup (crDir +~ aa))
MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w
DropItem -> undefined
ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat
AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
ImpulseUseTarget f -> fromMaybe w $ do
i <- cr ^? crIntention . targetCr . _Just
tcr <- w ^? cWorld . lWorld . creatures . ix i
return $ followImpulse cid w (doCrImp f tcr)
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld)
MvTurnToward p ->
crup $
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
where
clens = cWorld . lWorld . creatures . ix cid
cr = w ^?! cWorld . lWorld . creatures . ix cid
crup f = over clens f w
mvType = crMvType cr
speed = _mvSpeed mvType
turnRad = doFloatFloat $ _mvTurnRad mvType
cpos = cr ^. crPos . _xy
cdir = _crDir cr
posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos . _xy
rr a = randomR (- a, a) $ _randGen w
hitCr i =
cWorld . lWorld . creatures . ix i . crDamage
.:~ Blunt 100 (posFromID i) (posFromID i - cpos)