188 lines
7.4 KiB
Haskell
188 lines
7.4 KiB
Haskell
module Dodge.Creature.Rationality
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base.Collide
|
|
import Dodge.Creature.Action
|
|
--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 Data.Maybe
|
|
import qualified Data.IntMap.Strict as IM
|
|
import System.Random
|
|
import Control.Lens
|
|
import Control.Monad.Reader
|
|
import Data.Monoid
|
|
|
|
composeInternalAIs
|
|
:: [World -> Creature -> Creature]
|
|
-> World
|
|
-> Creature
|
|
-> Creature
|
|
composeInternalAIs fs w c = foldr ($ w) c fs
|
|
|
|
impulsiveAIR
|
|
:: (Creature -> Reader World Creature)
|
|
-> Creature
|
|
-> World
|
|
-> (Endo World , Maybe Creature)
|
|
impulsiveAIR impf cr w = bimap Endo Just $ followImpulses w . ($ w) . runReader $ impf cr
|
|
|
|
--impulsiveAI
|
|
-- :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
|
|
-- -> World
|
|
-- -> (World -> World,StdGen)
|
|
-- -> Creature
|
|
-- -> ((World -> World,StdGen), Maybe Creature)
|
|
--impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w
|
|
|
|
-- needs cleanup
|
|
followImpulses
|
|
:: World
|
|
-> Creature
|
|
-> (World -> World, Creature)
|
|
followImpulses w cr
|
|
= foldr
|
|
(\imp (f , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f , cr''))
|
|
(id, cr)
|
|
(_crImpulse $ _crActionPlan cr)
|
|
|
|
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 -> (crUseItem 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 ^? crTarget . _Just of
|
|
Just tcr -> followImpulse cr w (f $ _crID tcr)
|
|
_ -> (id,cr)
|
|
ImpulseUseTarget f -> case cr ^? crTarget . _Just of
|
|
Just tcr -> followImpulse cr w (f tcr)
|
|
_ -> (id,cr)
|
|
ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
|
_ -> (id , cr)
|
|
where
|
|
cpos = _crPos 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)
|
|
. soundOnce hitSound
|
|
addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams
|
|
|
|
actionUpdateAI
|
|
:: (World -> Creature -> Creature) -- ^ the function updating the actions
|
|
-> World
|
|
-> Creature
|
|
-> Creature
|
|
actionUpdateAI actF w c = performActions w $ actF w c
|
|
|
|
listGuard :: ([(a -> Bool, b)] , b) -> a -> b
|
|
listGuard ( (test,y):ps, z ) x
|
|
| test x = y
|
|
| otherwise = listGuard (ps, z) x
|
|
listGuard (_,z) _ = z
|
|
|
|
performActions :: World -> Creature -> Creature
|
|
performActions w cr = cr
|
|
& crActionPlan . crImpulse .~ concat iss
|
|
& crActionPlan . crAction .~ catMaybes mayas
|
|
where
|
|
(iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction
|
|
|
|
performActionsR :: Creature -> Reader World Creature
|
|
performActionsR cr = reader $ \w -> performActions w cr
|
|
|
|
|
|
{- | Performing an action means that a creature has some impulses for a frame, and
|
|
updates or deletes the action itself. -}
|
|
performAction
|
|
:: Creature
|
|
-> World
|
|
-> Action
|
|
-> ( [Impulse] , Maybe Action )
|
|
performAction cr w ac = case ac of
|
|
AimAtCloseSlow tcid p speed slowSpeed a
|
|
| canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a
|
|
-> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
|
|
| canSee (_crID cr) tcid w
|
|
-> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
|
|
| safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a
|
|
-> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
|
|
| otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
|
|
where
|
|
tpos = _crPos (_creatures w IM.! tcid)
|
|
WaitThen 0 newAc -> ([] , Just newAc)
|
|
WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc))
|
|
ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
|
|
ImpulsesList _ -> ([], Nothing)
|
|
DoImpulses imps -> (imps, Nothing)
|
|
DoActionThen fsta afta -> case performAction cr w fsta of
|
|
(imps , Just nxta) -> (imps, Just (DoActionThen nxta afta))
|
|
(imps , Nothing ) -> (imps, Just afta)
|
|
DoActionWhile f repa -> performAction cr w $ DoActionWhilePartial repa f repa
|
|
DoActionWhilePartial partAc f resetAc
|
|
| f (w,cr) -> case performAction cr w partAc of
|
|
(imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc)
|
|
(imps, _) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc)
|
|
| otherwise -> performAction cr w partAc
|
|
DoActionIf f ifa
|
|
| f (w,cr) -> performAction cr w ifa
|
|
| otherwise -> ([],Nothing)
|
|
DoActionIfElse ifa f elsea
|
|
| f (w,cr) -> performAction cr w ifa
|
|
| otherwise -> performAction cr w elsea
|
|
DoActionWhileInterrupt repa f afta
|
|
| f (w,cr) -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta)
|
|
| otherwise -> performAction cr w afta
|
|
DoActions [] -> ([], Nothing)
|
|
DoActions acs ->
|
|
let (imps, newAcs) = unzip $ map (performAction cr w) acs
|
|
in (concat imps, Just . DoActions $ catMaybes newAcs)
|
|
StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
|
|
PathTo p
|
|
| dist cpos p < 5 -> ([], Nothing)
|
|
| hasLOS cpos p w -> ([TurnToward p (pi/4),MoveForward 3] , Just (PathTo p))
|
|
| otherwise -> ([], Nothing)
|
|
LeadTarget p -> case cr ^? crTarget . _Just of
|
|
Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
|
|
_ -> ([], Nothing)
|
|
UseTargetCID f -> case cr ^? crTarget . _Just of
|
|
Just tcr -> performAction cr w (f $ _crID tcr)
|
|
_ -> ([],Nothing)
|
|
UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just
|
|
UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
|
|
ArbitraryAction f -> performAction cr w (f cr w)
|
|
DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
|
|
(imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
|
|
(imp, _) -> (sideImp ++ imp, Nothing)
|
|
DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
|
|
DoReplicatePartial _ 0 pac -> performAction cr w pac
|
|
DoReplicatePartial sac t pac -> case performAction cr w pac of
|
|
(imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac)
|
|
(imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
|
|
_ -> ([], Nothing)
|
|
where
|
|
cpos = _crPos cr
|
|
cdir = _crDir cr
|