89 lines
3.0 KiB
Haskell
89 lines
3.0 KiB
Haskell
module Dodge.Creature.Impulse
|
|
( impulsiveAIR
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Data.SoundOrigin
|
|
import Dodge.Creature.Impulse.Movement
|
|
import Dodge.Creature.Impulse.UseItem
|
|
import Dodge.Data.DamageType
|
|
--import Dodge.Creature.Action.UseItem
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Creature.Stance.Data
|
|
import Dodge.SoundLogic
|
|
import Dodge.SoundLogic.Synonyms
|
|
import Geometry
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import System.Random
|
|
import Control.Lens
|
|
import Control.Monad.Reader
|
|
import Data.Monoid
|
|
import Data.Bifunctor
|
|
|
|
impulsiveAIR
|
|
:: (Creature -> Reader World Creature)
|
|
-> Creature
|
|
-> World
|
|
-> (Endo World , Maybe Creature)
|
|
impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr
|
|
|
|
followImpulses
|
|
:: World
|
|
-> Creature
|
|
-> (World -> World, Creature)
|
|
followImpulses w cr
|
|
= foldr
|
|
foldf
|
|
(id, cr)
|
|
(_crImpulse $ _crActionPlan cr)
|
|
where
|
|
foldf imp (f,cr') = first ( . f) $ followImpulse cr' w imp
|
|
|
|
followImpulse
|
|
:: Creature
|
|
-> World
|
|
-> Impulse
|
|
-> (World -> World , Creature)
|
|
followImpulse cr w imp = case imp of
|
|
Move p -> (id, crMvBy p cr)
|
|
MoveForward x -> (id, crMvForward x cr)
|
|
Turn a -> (id, creatureTurn a cr)
|
|
TurnToward p a -> (id, creatureTurnToward p a cr)
|
|
TurnTo p -> (id, creatureTurnTo p cr)
|
|
ChangePosture post -> (id, cr & crStance . posture .~ post)
|
|
UseItem -> (tryUseItem cr, cr)
|
|
SwitchToItem i -> (id, cr & crInvSel .~ i)
|
|
Melee cid' ->
|
|
(hitCr cid'
|
|
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown?
|
|
RandomTurn a -> (id, creatureTurn (rr a) cr)
|
|
MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr )
|
|
DropItem -> undefined
|
|
ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
|
|
AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) )
|
|
ArbitraryImpulseFunction f -> (id, f w cr)
|
|
ArbitraryImpulse f -> followImpulse cr w (f cr w)
|
|
ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
|
|
Just tcr -> followImpulse cr w (f $ _crID tcr)
|
|
_ -> (id,cr)
|
|
ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
|
|
Just tcr -> followImpulse cr w (f tcr)
|
|
_ -> (id,cr)
|
|
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
|
MvForward -> (id, crMvForward speed cr)
|
|
MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr)
|
|
-- _ -> (id , cr)
|
|
where
|
|
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 = fst $ randomR (-a,a) $ _randGen w
|
|
hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
|
|
. soundFrom (CrSound cid) cpos hitSound Nothing
|
|
addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams
|