117 lines
4.0 KiB
Haskell
117 lines
4.0 KiB
Haskell
module Dodge.Creature.Impulse.Movement where
|
|
import Dodge.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, will be made relative to creature direction
|
|
-> Creature
|
|
-> Creature
|
|
crMvBy p' cr = advanceStepCounter (magV p) cr
|
|
& crPos %~ (+.+ p)
|
|
& crMvDir .~ argV p
|
|
where
|
|
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
|
|
equipFactor
|
|
| _posture (_crStance cr) == Aiming
|
|
= product $ map equipAimSpeed $ IM.elems $ _crInv cr
|
|
| otherwise = product $ map equipSpeed $ IM.elems $ _crInv cr
|
|
aimingFactor
|
|
| _posture (_crStance cr) == Aiming = fromMaybe 1 $ it ^? itUse . useAim . aimSpeed
|
|
| otherwise = 1
|
|
it = _crInv cr IM.! _crInvSel cr
|
|
|
|
crMvAbsolute
|
|
:: Point2 -- ^ Movement translation vector
|
|
-> Creature
|
|
-> Creature
|
|
crMvAbsolute p' cr = advanceStepCounter (magV p) cr
|
|
& crPos %~ (+.+ p)
|
|
& crMvDir .~ argV p
|
|
where
|
|
p = (*.*) (equipFactor * aimingFactor) p'
|
|
equipFactor
|
|
| _posture (_crStance cr) == Aiming
|
|
= product $ map equipAimSpeed $ IM.elems $ _crInv cr
|
|
| _posture (_crStance cr) == Reloading
|
|
= product $ map equipAimSpeed $ IM.elems $ _crInv cr
|
|
| otherwise = product $ map equipSpeed $ IM.elems $ _crInv cr
|
|
aimingFactor
|
|
| _posture (_crStance cr) == Aiming || _posture (_crStance cr) == Reloading
|
|
= fromMaybe 1 $ it ^? itUse . useAim . aimSpeed
|
|
| otherwise = 1
|
|
it = _crInv cr IM.! _crInvSel cr
|
|
|
|
crMvForward
|
|
:: Float -- ^ Speed
|
|
-> Creature
|
|
-> Creature
|
|
crMvForward speed = crMvBy (V2 speed 0)
|
|
|
|
advanceStepCounter
|
|
:: Float -- ^ Speed
|
|
-> Creature
|
|
-> Creature
|
|
advanceStepCounter speed cr = cr & crStance . carriage %~ f
|
|
where
|
|
--stnce = _crStance cr
|
|
f car = case car of
|
|
Standing -> f (Walking 0 RightForward)
|
|
Walking i ff -> Walking (i + ceiling speed) ff
|
|
_ -> car
|
|
|
|
creatureTurn :: Float -> Creature -> Creature
|
|
creatureTurn a = crDir +~ a
|
|
|
|
creatureTurnTo :: Point2 -> Creature -> Creature
|
|
creatureTurnTo p cr
|
|
| vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
|
|
| otherwise = cr & crDir .~ dirToTarget
|
|
where
|
|
vToTarg = p -.- _crPos cr
|
|
dirToTarget = argV vToTarg
|
|
|
|
-- the following is perhaps not ideal because it mixes normalizeAngle with
|
|
-- angleVV, but it seems to work
|
|
creatureTurnTowardDir
|
|
:: Float -- ^ Angle
|
|
-> Float -- ^ Turn speed
|
|
-> Creature
|
|
-> Creature
|
|
creatureTurnTowardDir a turnSpeed cr
|
|
| normalizeAngle (abs (a - cdir)) <= turnSpeed
|
|
= cr & crDir .~ dirToTarget
|
|
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr)
|
|
= cr & crDir +~ turnSpeed
|
|
| otherwise = cr & crDir -~ turnSpeed
|
|
where
|
|
cdir = _crDir cr
|
|
vToTarg = rotateV a (V2 1 0)
|
|
dirToTarget = argV vToTarg
|
|
|
|
creatureTurnToward :: Point2 -> Float -> Creature -> Creature
|
|
creatureTurnToward p turnSpeed cr
|
|
| vToTarg == V2 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 -- TODO remove/rethink
|
|
equipAimSpeed it
|
|
| _itType it == FRONTARMOUR = 0.5
|
|
| _itType it == FLAMESHIELD = 0.5
|
|
| otherwise = 1
|