120 lines
5.0 KiB
Haskell
120 lines
5.0 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
--{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.Creature.Impulse (followImpulse) where
|
|
|
|
import RandomHelp
|
|
import Control.Applicative
|
|
--import Control.Monad.Trans.State.Lazy
|
|
--import Control.Monad.State -- moving from mtl to transformers
|
|
import Data.Maybe
|
|
import Dodge.Creature.Impulse.Movement
|
|
import Dodge.Creature.MoveType
|
|
--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 Linear
|
|
--import System.Random
|
|
|
|
-- note SwitchToItem doesn't necessarily update the root item correctly
|
|
followImpulse :: Int -> World -> Impulse -> World
|
|
followImpulse cid w = \case
|
|
UpdateRandGen -> w & randGen %~ (snd . randomR (0::Int,1))
|
|
ImpulseNothing -> w
|
|
RandomImpulse rimp ->
|
|
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
|
|
in randGen .~ newgen $ followImpulse cid w newimp
|
|
Bark sid ->
|
|
soundStart (CrMouth cid) cpos sid Nothing $
|
|
w & clens %~ resetCrVocCoolDown w
|
|
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld)
|
|
Walk p -> crup $ crWalk p (w ^. cWorld . lWorld)
|
|
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld)
|
|
MoveNoStride p -> crup $ crMvByNoStride p (w ^. cWorld . lWorld)
|
|
Turn a -> crup $ crDir +~ a
|
|
TurnToward p a -> crup $ creatureTurnToward p a
|
|
TurnTo p -> crup $ creatureTurnTo p
|
|
ChangePosture post -> crup $ crStance . posture .~ post
|
|
UseItem -> undefined
|
|
-- SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
|
|
Melee tid ->
|
|
hitCr tid $ crup $ meleeMovement w tid . (crType . meleeCooldown .~ 20)
|
|
MeleeL cid' ->
|
|
hitCrd (-pi/2) cid' $
|
|
crup
|
|
-- ( crMvAbsolute (w ^. cWorld . lWorld) (vNormal $ 10 *.* normalizeV (posFromID cid' -.- cpos))
|
|
-- .
|
|
(crType . meleeCooldownL .~ 20)
|
|
-- )
|
|
MeleeR cid' ->
|
|
hitCrd (pi/2) cid' $
|
|
crup
|
|
--( crMvAbsolute (w ^. cWorld . lWorld) (vNormal $ (-10) *.* normalizeV (posFromID cid' -.- cpos)) .
|
|
(crType . meleeCooldownR .~ 20)
|
|
--)
|
|
RandomTurn a ->
|
|
let (aa, g) = rr a
|
|
in (randGen .~ g) (crup (crDir +~ aa))
|
|
MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w
|
|
DropItem -> undefined
|
|
ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat
|
|
-- AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
|
|
ImpulseUseTarget f -> fromMaybe w $ do
|
|
i <- cr ^? crIntention . targetCr . _Just
|
|
tcr <- w ^? cWorld . lWorld . creatures . ix i
|
|
return $ followImpulse cid w (doCrImp f tcr)
|
|
MvForward -> crup $ crMvForward' (w ^. cWorld . lWorld)
|
|
MvTurnToward p ->
|
|
crup $
|
|
mvTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
|
|
SetBeeRandomMovement -> w & setBeeRandomMovement cid
|
|
where
|
|
clens = cWorld . lWorld . creatures . ix cid
|
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
|
crup f = over clens f w
|
|
mvType = crMvType cr
|
|
-- speed = _mvSpeed mvType
|
|
turnRad = fromMaybe (const 0.1) $
|
|
mvType ^? mvTurnRad . to doFloatFloat
|
|
<|> mvType ^? mvTurnSpeed . to const
|
|
-- | Just x <- = doFloatFloat $ _mvTurnRad mvType
|
|
cpos = cr ^. crPos . _xy
|
|
cdir = _crDir 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) (CrMeleeO cid)
|
|
hitCrd a i =
|
|
cWorld . lWorld . creatures . ix i . crDamage
|
|
<>~ [Blunt 100 (posFromID i) (posFromID i - cpos) (CrMeleeO cid)
|
|
, Inertial 0 (posFromID i) (50 * unitVectorAtAngle (cr ^. crDir + a)) (CrMeleeO cid)
|
|
]
|
|
|
|
meleeMovement :: World -> Int -> Creature -> Creature
|
|
meleeMovement w tid cr = case cr ^. crType of
|
|
HoverCrit {} -> fromMaybe cr $ do
|
|
txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy
|
|
return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (cr ^. crPos . _xy - txy)) cr
|
|
ChaseCrit {} -> fromMaybe cr $ do
|
|
txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy
|
|
return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (txy - cr ^. crPos . _xy)) cr
|
|
_ -> cr
|
|
|
|
setBeeRandomMovement :: Int -> World -> World
|
|
setBeeRandomMovement cid w = fromMaybe w $ do
|
|
mff <- w ^? cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement
|
|
return $ case mff of
|
|
Just _ -> w & cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement .~ Nothing
|
|
Nothing -> w & cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement .~ x
|
|
& randGen .~ g
|
|
where
|
|
(x,g) = runState (takeOne [Nothing,Just LeftForward,Just RightForward]) (w ^. randGen)
|
|
|