80 lines
2.9 KiB
Haskell
80 lines
2.9 KiB
Haskell
module Dodge.DrWdWd where
|
|
|
|
import Control.Lens
|
|
import Data.Foldable
|
|
import qualified Data.IntSet as IS
|
|
import Dodge.Base
|
|
import Dodge.Block.Debris
|
|
import Dodge.Data.World
|
|
import Dodge.LevelGen.DoorPane
|
|
import Dodge.Placement.PlaceSpot.TriggerDoor
|
|
import Dodge.SoundLogic
|
|
import Dodge.Wall.Move
|
|
import Dodge.WorldBool
|
|
import Geometry
|
|
|
|
doDrWdWd :: DrWdWd -> Door -> World -> World
|
|
doDrWdWd dww = case dww of
|
|
DrWdId -> const id
|
|
DrWdMakeDoorDebris -> makeDoorDebris
|
|
DrWdMechanismStepwise nsteps wlids pss -> doorMechanismStepwise nsteps wlids pss
|
|
DoorMechanism -> doorMechanism
|
|
|
|
-- TODO sort out why DoorClosed status does not update correctly 22/06/23
|
|
doorMechanism :: Door -> World -> World
|
|
doorMechanism dr w = case mvDir of
|
|
Just d ->
|
|
w
|
|
& flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
|
|
& moveUpdate
|
|
& cWorld . lWorld . doors . ix drid . drPos . each %~ (+.+ d)
|
|
& maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
|
|
Nothing -> w
|
|
where
|
|
toOpen = doWdBl (_drTrigger dr) w
|
|
mvDir
|
|
| toOpen && _drStatus dr == DoorOpen = Nothing -- Not sure why necessary
|
|
| toOpen && dist dpos dop > 0.5 = Just $ vecBetweenSpeed speed dpos dop
|
|
| dist dpos dcp > 0.5 = Just $ vecBetweenSpeed speed dpos dcp
|
|
| otherwise = Nothing
|
|
speed = _drSpeed dr
|
|
drid = _drID dr
|
|
moveUpdate = playSound . setStatus
|
|
playSound
|
|
| _drPushedBy dr == PushesItself = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
|
|
| otherwise = id
|
|
dpos = snd $ _drPos dr
|
|
dop = snd $ _drOpenPos dr
|
|
dcp = snd $ _drClosePos dr
|
|
setStatus
|
|
| dist dpos dop < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorOpen
|
|
| dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed
|
|
| otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway
|
|
|
|
-- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
|
|
-- TODO update _drPos
|
|
-- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed
|
|
-- perhaps only store intermediate door pos pairs, calculate all wall positions
|
|
-- on the fly
|
|
doorMechanismStepwise :: Int -> [Int] -> [(Point2, Point2)] -> Door -> World -> World
|
|
doorMechanismStepwise nsteps wlids pss dr w
|
|
| toOpen = case _drStatus dr of
|
|
DoorInt x | x == nsteps -> w
|
|
DoorInt x -> setWalls (x + 1)
|
|
_ -> w
|
|
| otherwise = case _drStatus dr of
|
|
DoorInt 0 -> w
|
|
DoorInt x -> setWalls (x -1)
|
|
_ -> w
|
|
where
|
|
drid = _drID dr
|
|
playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
|
|
toOpen = doWdBl (_drTrigger dr) w
|
|
setWalls n =
|
|
playSound (foldl' (&) w (zipWith moveWallID wlids newps))
|
|
& cWorld . lWorld . doors . ix drid . drStatus .~ DoorInt n
|
|
where
|
|
newps = uncurry (rectanglePairs 9) (pss !! n)
|
|
|
|
-- it is not at all clear that the zoning selects the correct walls
|