Files
loop/src/Dodge/DrWdWd.hs
T

42 lines
1.2 KiB
Haskell

module Dodge.DrWdWd (doDrWdWd) where
import Control.Lens
import Data.Maybe
import Dodge.Block.Debris
import Dodge.Data.World
import Dodge.ShiftPoint
import Dodge.SoundLogic
import Dodge.Wall.Move
import Dodge.WorldBool
doDrWdWd :: DrWdWd -> Door -> World -> World
doDrWdWd dww = case dww of
DrWdId -> const id
DrWdMakeDoorDebris -> makeDoorDebris
DoorLerp -> doorLerp
doorLerp :: Door -> World -> World
doorLerp dr w = fromMaybe w $ do
x <- newlerp
return $
f x
& playSound x
& cWorld . lWorld . doors . ix drid . drLerp .~ x
where
f = ifoldl' (flip . moveWallID) w . wlposs
p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos)
wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (p2a x)
clerp = dr ^. drLerp
newlerp
| toOpen && clerp < 1 = Just . min 1 $ clerp + speed
| clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
| otherwise = Nothing
toOpen = doWdBl (_drTrigger dr) w
speed = _drSpeed dr
drid = _drID dr
playSound x
| _drPushedBy dr == PushesItself =
soundContinue (WallSound drid) (fst $ p2a x) slideDoorS (Just 1)
| otherwise = id
-- dpos = snd $ _drPos dr