122 lines
4.0 KiB
Haskell
122 lines
4.0 KiB
Haskell
module Dodge.CreatureEffect where
|
|
|
|
import Data.Maybe
|
|
import Dodge.Base.Collide
|
|
import Dodge.Creature.Test
|
|
import Dodge.Data.CreatureEffect
|
|
import Dodge.Data.World
|
|
import Dodge.Path
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
|
|
doWdCrCr :: WdCrCr -> World -> Creature -> Creature
|
|
doWdCrCr ce = case ce of
|
|
NoCreatureEffect -> const id
|
|
|
|
doCrWdImp :: CrWdImp -> Creature -> World -> Impulse
|
|
doCrWdImp cwi = case cwi of
|
|
NoCrWdImp -> const $ const ImpulseNothing
|
|
|
|
doCrWdWd :: CrWdWd -> Creature -> World -> World
|
|
doCrWdWd cww = case cww of
|
|
CrWdWdId -> const id
|
|
|
|
doIntImp :: IntImp -> Int -> Impulse
|
|
doIntImp ii = case ii of
|
|
NoIntImp -> const ImpulseNothing
|
|
|
|
doCrImp :: CrImp -> Creature -> Impulse
|
|
doCrImp ci = case ci of
|
|
NoCrImp -> const ImpulseNothing
|
|
TurnTowardCr x -> \cr -> TurnToward (_crPos cr) x
|
|
|
|
doP2Imp :: P2Imp -> Point2 -> Impulse
|
|
doP2Imp p2i = case p2i of
|
|
P2ImpNo -> const ImpulseNothing
|
|
|
|
doWdCrBl :: WdCrBl -> World -> Creature -> Bool
|
|
doWdCrBl wcb = case wcb of
|
|
WdCrTrue -> const $ const True
|
|
WdCrBlfromCrBl cb -> \_ cr -> doCrBl cb cr
|
|
WdCrNegate wcb' -> \w -> not . doWdCrBl wcb' w
|
|
WdCrLOSTarget -> \w cr ->
|
|
maybe
|
|
False
|
|
(\cid -> canSee (_crID cr) cid w)
|
|
(_crID <$> _targetCr (_crIntention cr))
|
|
WdCrSafeDistFromTarget x -> \_ -> crSafeDistFromTarg x -- currently ignores walls etc
|
|
|
|
doCrBl :: CrBl -> Creature -> Bool
|
|
doCrBl cb = case cb of
|
|
CrCanShoot -> crCanShoot
|
|
CrIsReloading -> crIsReloading
|
|
CrIsAiming -> crIsAiming
|
|
CrIsAnimate -> isAnimate
|
|
|
|
doMCrAc :: MCrAc -> Maybe Creature -> Action
|
|
doMCrAc mca = case mca of
|
|
MCrNoAction -> const ActionNothing
|
|
|
|
doCrAc :: CrAc -> Creature -> Action
|
|
doCrAc ca = case ca of
|
|
CrTurnAround -> \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr))
|
|
CrFleeFromTarget -> fleeFromTarget
|
|
|
|
fleeFromTarget :: Creature -> Action
|
|
fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr))
|
|
|
|
doP2Ac :: P2Ac -> Point2 -> Action
|
|
doP2Ac p2a = case p2a of
|
|
P2NoAction -> const ActionNothing
|
|
|
|
doMP2Ac :: MP2Ac -> Maybe Point2 -> Action
|
|
doMP2Ac mp2a = case mp2a of
|
|
MP2NoAction -> const ActionNothing
|
|
|
|
doCrWdAc :: CrWdAc -> Creature -> World -> Action
|
|
doCrWdAc cw = case cw of
|
|
CrWdBFSThenReturn t -> \cr w -> fromMaybe NoAction $ do
|
|
n <- walkableNodeNear w (_crPos cr)
|
|
let as = take 20 $ map PathTo $ bfsNodePoints n w
|
|
return $
|
|
DoReplicate t $
|
|
foldr DoActionThen NoAction as
|
|
ChooseMovementSpreadGun -> chooseMovementSpreadGun
|
|
ChooseMovementLtAuto -> chooseMovementLtAuto
|
|
|
|
chooseMovementSpreadGun :: Creature -> World -> Action
|
|
chooseMovementSpreadGun cr w
|
|
| dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi =
|
|
DoImpulses [UseItem, MoveForward (-3)]
|
|
| d < 30 = DoImpulses [UseItem, TurnToward p 0.06]
|
|
| d < 60 = DoImpulses [UseItem, TurnToward p 0.06, MoveForward 3]
|
|
| d < 100 = DoImpulses [TurnToward p 0.06, MoveForward 3]
|
|
| d < 200 = DoImpulses [TurnToward p (0.06 + 0.002 * (d -100)), MoveForward 3]
|
|
| otherwise =
|
|
DoImpulses [TurnToward p 0.26, MoveForward 3]
|
|
where
|
|
d = dist cpos p
|
|
cpos = _crPos cr
|
|
tcr = _creatures (_cWorld w) IM.! 0
|
|
p = _crPos tcr
|
|
|
|
chooseMovementLtAuto :: Creature -> World -> Action
|
|
chooseMovementLtAuto cr w
|
|
| dist cpos p > 200 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward 3]
|
|
| dist cpos p < 80 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward (-3)]
|
|
| errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 =
|
|
DoImpulses [UseItem, TurnToward p' 0.01, Move (V2 0 3)]
|
|
| otherwise =
|
|
DoImpulses [UseItem, TurnToward p' 0.05, Move (V2 0 3)]
|
|
where
|
|
cpos = _crPos cr
|
|
tcr = _creatures (_cWorld w) IM.! 0
|
|
p = _crPos tcr
|
|
v = vNormal $ p -.- cpos
|
|
p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v)
|
|
|
|
fleeFrom :: Creature -> Maybe Creature -> Action
|
|
fleeFrom cr mtcr = case mtcr of
|
|
Just tcr -> DoImpulses [MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi / 4)]
|
|
Nothing -> NoAction
|