71 lines
2.3 KiB
Haskell
71 lines
2.3 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Door (updateDoor) where
|
|
|
|
import Data.Foldable
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Dodge.Data.World
|
|
import Dodge.Door.DoorLerp
|
|
import Dodge.ShiftPoint
|
|
import Dodge.SoundLogic
|
|
import Dodge.Wall.Move
|
|
import Dodge.WorldBool
|
|
import Dodge.Zoning.Base
|
|
import Dodge.Zoning.Pathing
|
|
import Geometry.Data
|
|
import LensHelp
|
|
import Linear
|
|
import Picture.Data
|
|
import Shape.Data
|
|
|
|
updateDoor :: Door -> World -> (S.Set Int2, World)
|
|
updateDoor dr w
|
|
| DoorLerp x <- dr ^. drUpdate = doorLerp x dr w
|
|
| otherwise =
|
|
( mempty
|
|
, foldl' (doDoorMount (doDoorLerp dr (dr ^. drLerp))) w (dr ^. drMounts)
|
|
)
|
|
|
|
doDoorMount :: Point2A -> World -> MountedObject -> World
|
|
doDoorMount pa w = \case
|
|
MountedLight p r c ->
|
|
w & cWorld . lWorld . lights .:~ LSParam (p & _xy %~ shiftPointBy pa) r c
|
|
MountedSPic x ->
|
|
w & cWorld . lWorld . tempSPic
|
|
<>~ ( x & _1 . each . sfVs . each . _xy %~ shiftPointBy pa
|
|
& _2 . each . vxPos . _xy %~ shiftPointBy pa
|
|
)
|
|
|
|
doorLerp :: Float -> Door -> World -> (S.Set Int2, World)
|
|
doorLerp speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w) $ do
|
|
x <- newlerp
|
|
let ps = wlposs x
|
|
ps' = wlposs (dr ^. drLerp)
|
|
is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (ps <> ps')
|
|
-- it seems possible that this will miss some paths: we don't add zones for the
|
|
-- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
|
|
return
|
|
( is
|
|
, domounts x $
|
|
f x
|
|
& playSound x
|
|
& cWorld . lWorld . doors . ix drid . drLerp .~ x
|
|
)
|
|
where
|
|
domounts x w' = foldl' (doDoorMount (doDoorLerp dr x)) w' (dr ^. drMounts)
|
|
f = ifoldl' (flip . moveWallID) w . wlposs
|
|
wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr 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
|
|
drid = _drID dr
|
|
playSound x
|
|
| _drPushedBy dr == PushesItself =
|
|
soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
|
|
| otherwise = id
|
|
|