Files
loop/src/Dodge/Creature/State/WalkCycle.hs
T

67 lines
2.5 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.State.WalkCycle (updateCarriage) where
import Geometry.Polygon
import Data.Maybe
import Dodge.Creature.HandPos
import Linear
import Control.Lens
import Dodge.Data.World
import Dodge.SoundLogic
import Sound.Data
updateCarriage :: Int -> World -> World
updateCarriage cid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
return $ updateCarriage' cid cr w (cr ^. crStance . carriage)
updateCarriage' :: Int -> Creature -> World -> Carriage -> World
updateCarriage' cid cr w = \case
Walking -> case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just x,Just ff) | x >= strideLength cr -> w
& soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos . _xy)
(chooseFootSound ff)
Nothing
& over (cWorld . lWorld . creatures . ix cid . crType) resetStride
& tocr . crPos . _xy +~ 0.5 *^ (cr ^. crOldPos - oop) ^. _xy
_ -> w & tocr . crPos . _xy +~ 0.5 *^ (cr ^. crOldPos - oop) ^. _xy
Floating -> w
Flying {_zSpeed = dz, _flyInertia = x} ->
w & cWorld . lWorld . creatures . ix cid . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop ^. _xy)
& cWorld . lWorld . creatures . ix cid . crPos . _z +~ dz
& cWorld . lWorld . creatures . ix cid . crStance . carriage . zSpeed
%~ if cr ^. crPos . _z < 17 then min 0.05 . (+0.001) else max (-0.05) . subtract 0.001
Boosting {} -> w
Falling {} ->
let v = 0.95 *^ (cr ^. crOldPos - oop & _z -~ 0.5)
ep = cr ^. crPos + v
in if ep ^. _z < 0 && not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms))
then w & tocr . crPos .~ (ep & _z .~ 0)
& cWorld . lWorld . creatures . ix cid . crStance . carriage .~ OnGround
else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep
OnGround {} -> w
& tocr . crPos +~ 0.8 *^ (cr ^. crOldPos - oop)
where
tocr = cWorld . lWorld . creatures . ix cid
oop = cr ^. crOldOldPos
f v | norm v > 10 = 10 *^ signorm v
| otherwise = v
resetStride :: CreatureType -> CreatureType
resetStride ct = case ct ^? footForward of
Just _ -> ct & strideAmount .~ 0 & footForward %~ normalGait
_ -> ct
normalGait :: FootForward -> FootForward
normalGait = \case
LeftForward -> RightForward
RightForward -> LeftForward
chooseFootSound :: FootForward -> SoundID
chooseFootSound LeftForward = foot1S
chooseFootSound _ = foot2S