99 lines
3.8 KiB
Haskell
99 lines
3.8 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Creature.Impulse
|
|
( impulsiveAIBefore
|
|
, followThenClearImpulses
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Creature.Vocalization
|
|
import Dodge.Creature.Impulse.Movement
|
|
import Dodge.Creature.Impulse.UseItem
|
|
import Dodge.SoundLogic
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import System.Random
|
|
import Control.Monad.State
|
|
import Data.Bifunctor
|
|
--import Data.Maybe
|
|
--
|
|
impulsiveAIBeforeAfter
|
|
:: (World -> Creature -> Creature)
|
|
-> (World -> Creature -> Creature)
|
|
-> Creature -> World -> World
|
|
impulsiveAIBeforeAfter startup endup cr w = w' & creatures . ix (_crID cr) .~ endup w' cr'
|
|
where
|
|
w' = g w
|
|
(g,cr') = impulsiveAI startup cr w
|
|
|
|
impulsiveAIBefore :: (World -> Creature -> Creature)
|
|
-> Creature -> World -> World
|
|
impulsiveAIBefore f cr w = g w & creatures . ix (_crID cr) .~ cr'
|
|
where
|
|
(g,cr') = impulsiveAI f cr w
|
|
|
|
impulsiveAI
|
|
:: (World -> Creature -> Creature) -- | internal creature update
|
|
-> Creature
|
|
-> World
|
|
-> (World -> World , Creature)
|
|
impulsiveAI f cr w = followImpulses w $ f w cr
|
|
|
|
|
|
followThenClearImpulses :: Creature -> World -> World
|
|
followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . crImpulse .~ [])
|
|
|
|
followImpulses :: World -> Creature -> (World -> World, Creature)
|
|
followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr)
|
|
where
|
|
f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp
|
|
|
|
followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
|
|
followImpulse cr w imp = case imp of
|
|
RandomImpulse rimp ->
|
|
let (newimp,newgen) = runState rimp (_randGen w)
|
|
in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
|
|
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
|
|
Move p -> crup $ crMvBy p cr
|
|
MoveForward x -> crup $ crMvForward x cr
|
|
Turn a -> crup $ creatureTurn a cr
|
|
TurnToward p a -> crup $ creatureTurnToward p a cr
|
|
TurnTo p -> crup $ creatureTurnTo p cr
|
|
ChangePosture post -> crup $ cr & crStance . posture .~ post
|
|
UseItem -> (useItem cr, cr)
|
|
SwitchToItem i -> crup $ cr & crInvSel .~ i
|
|
Melee cid' -> (hitCr cid'
|
|
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
|
|
RandomTurn a -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
|
|
MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
|
|
DropItem -> undefined
|
|
ChangeStrategy strat -> crup $ cr & crActionPlan . crStrategy .~ strat
|
|
AddGoal gl -> crup $ cr & crActionPlan . crGoal .:~ gl
|
|
ArbitraryImpulseFunction f -> crup $ f w cr
|
|
ArbitraryImpulse f -> followImpulse cr w (f cr w)
|
|
ArbitraryImpulseEffect f -> (f cr, cr)
|
|
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
|
|
Just tcr -> followImpulse cr w (f $ _crID tcr)
|
|
_ -> crup cr
|
|
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
|
|
Just tcr -> followImpulse cr w (f tcr)
|
|
_ -> crup cr
|
|
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
|
MvForward -> crup $ crMvForward speed cr
|
|
MvTurnToward p -> crup
|
|
$ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
|
|
where
|
|
crup = (id,)
|
|
mvType = _crMvType cr
|
|
speed = _mvSpeed mvType
|
|
turnRad = _mvTurnRad mvType
|
|
cpos = _crPos cr
|
|
cdir = _crDir cr
|
|
cid = _crID cr
|
|
posFromID cid' = _crPos $ _creatures w IM.! cid'
|
|
rr a = randomR (-a,a) $ _randGen w
|
|
hitCr i = (creatures . ix i . crState . csDamage
|
|
.:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
|
|
)
|
|
. soundStart (CrSound cid) cpos hitS Nothing
|