94 lines
3.8 KiB
Haskell
94 lines
3.8 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.Creature.Impulse (impulsiveAIBefore) where
|
|
|
|
import Data.Maybe
|
|
import Linear
|
|
import NewInt
|
|
import Dodge.Creature.MoveType
|
|
import Data.Foldable
|
|
import Control.Monad.State
|
|
import Data.Bifunctor
|
|
import Dodge.Creature.Impulse.Movement
|
|
--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 System.Random
|
|
|
|
impulsiveAIBefore ::
|
|
(World -> Creature -> Creature) ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
impulsiveAIBefore f cr w = g w & cWorld . lWorld . creatures . ix (_crID cr) .~ cr'
|
|
where
|
|
(g, cr') = followImpulses w $ f w cr
|
|
|
|
followImpulses :: World -> Creature -> (World -> World, Creature)
|
|
followImpulses w cr = foldl' (flip f) (id, cr) (reverse $ _apImpulse $ _crActionPlan cr)
|
|
where
|
|
f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
|
|
|
|
-- note SwitchToItem doesn't necessarily update the root item correctly
|
|
followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature)
|
|
followImpulse cr w imp = case imp of
|
|
ImpulseNothing -> (id, cr)
|
|
RandomImpulse rimp ->
|
|
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
|
|
in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
|
|
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr)
|
|
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr
|
|
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
|
|
Turn a -> crup $ cr & crDir +~ a
|
|
TurnToward p a -> crup $ creatureTurnToward p a cr
|
|
TurnTo p -> crup $ creatureTurnTo p cr
|
|
ChangePosture post -> crup $ cr & crStance . posture .~ post
|
|
UseItem -> undefined
|
|
-- UseItem -> (useSelectedItem $ _crID cr
|
|
-- , cr)
|
|
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
|
|
Melee cid' ->
|
|
( hitCr cid'
|
|
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
|
|
)
|
|
RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
|
|
MakeSound sid -> (soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing, cr)
|
|
DropItem -> undefined
|
|
ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat
|
|
AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl
|
|
ArbitraryImpulseFunction f -> crup $ doWdCrCr f w cr
|
|
ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w)
|
|
ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr)
|
|
-- ImpulseUseTargetCID f -> fromMaybe (crup cr) $ do
|
|
-- i <- cr ^? crIntention . targetCr . _Just
|
|
-- tcr <- w ^? cWorld . lWorld . creatures . ix i
|
|
-- return $ followImpulse cr w (doIntImp f $ _crID tcr)
|
|
ImpulseUseTarget f -> fromMaybe (crup cr) $ do
|
|
i <- cr ^? crIntention . targetCr . _Just
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix i
|
|
return $ followImpulse cr w (doCrImp f tcr)
|
|
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (cr ^. crPos . _xy +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
|
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
|
|
MvTurnToward p ->
|
|
crup $
|
|
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
|
|
where
|
|
crup = (id,)
|
|
mvType = crMvType cr
|
|
speed = _mvSpeed mvType
|
|
turnRad = doFloatFloat $ _mvTurnRad mvType
|
|
cpos = cr ^. crPos . _xy
|
|
cdir = _crDir cr
|
|
cid = _crID 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)
|