Files
loop/src/Dodge/Creature/Update.hs
T

54 lines
1.9 KiB
Haskell

module Dodge.Creature.Update (
updateCreature,
) where
import LensHelp
import Geometry
import Dodge.SoundLogic
import Dodge.Creature.Radius
import Dodge.Creature.YourControl
import Dodge.Creature.State
import Dodge.Barreloid
import Dodge.Data.World
import Dodge.Humanoid
import Dodge.Lampoid
import qualified Data.List as List
-- Should separate out creature movement from other parts here
updateCreature :: Creature -> World -> World
updateCreature cr
| _crZ cr < negate 100 = id -- can remove creature and all items
| _crZ cr < 0 = (tocr . crZVel -~ 0.5)
. (tocr . crZ +~ _crZVel cr)
| otherwise = updateCreature' cr
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
updateCreature' :: Creature -> World -> World
updateCreature' cr = chasmTest cr . case _crType cr of
Avatar{} -> (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
. crUpdate yourControl cr
LampCrit{} -> updateLampoid cr
BarrelCrit bt -> updateBarreloid bt cr
AvatarDead -> id
_ -> crUpdate updateHumanoid cr
chasmTest :: Creature -> World -> World
chasmTest cr w
| _crZVel cr < 0 = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
& cWorld . lWorld . creatures . ix (_crID cr) . crZ +~ _crZVel cr
| Just (x,y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) = w
& soundContinue (CrChasm (_crID cr)) (_crPos cr) debrisS (Just 100)
& cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ normalizeV (vNormal (x-y))
| any f (w ^. cWorld . chasms) = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
| otherwise = w
where
g = uncurry $ circOnSeg (_crPos cr) (crRad $ cr ^. crType)
f = circInPolygon (_crPos cr) (crRad $ cr ^. crType)
updatePulse :: Pulse -> Pulse
updatePulse PulseStatus {_pulseRate = pr, _pulseProgress = pp}
| pp >= pr = PulseStatus pr 0
| otherwise = PulseStatus pr (pp + 1)