Files
loop/src/Dodge/Creature/Action/Movement.hs
T

74 lines
2.3 KiB
Haskell

module Dodge.Creature.Action.Movement
where
import Dodge.Data
import Dodge.Creature.Stance.Data
import Geometry
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import Control.Lens
{- | Creature attempts to moves under its own steam.
The idea is that this may or may not work, depending on the status of the creature.
For now, though, this cannot fail. -}
crMvBy
:: Point2 -- ^ Movement translation vector
-> Creature
-> Creature
crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
where
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
aimingFactor
| _posture (_crStance cr) == Aiming = fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
crMvForward
:: Float -- ^ Speed
-> Creature
-> Creature
crMvForward speed = crMvBy (speed,0)
advanceStepCounter
:: Float -- ^ Speed
-> Creature
-> Creature
advanceStepCounter speed = crStance . carriage %~ f
where
f w@Walking{} = w{_stepToAdd = ceiling speed}
f s = s
creatureTurn :: Float -> Creature -> Creature
creatureTurn a = crDir +~ a
creatureTurnTo :: Point2 -> Creature -> Creature
creatureTurnTo p cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| otherwise = cr & crDir .~ dirToTarget
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
creatureTurnToward :: Point2 -> Float -> Creature -> Creature
creatureTurnToward p turnSpeed cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= cr & crDir .~ dirToTarget
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
{- | Speed modifier of an item when not aiming. -}
equipSpeed :: Item -> Float
equipSpeed _ = 1
{- | Speed modifier of an item when aiming. -}
equipAimSpeed :: Item -> Float
equipAimSpeed NoItem = 1
equipAimSpeed it
| _itIdentity it == FrontArmour = 0.75
| _itIdentity it == FlameShield = 0.75
| otherwise = 1