diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 11855dfe5..aaf5299eb 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -460,7 +460,7 @@ mvPointTowardAtSpeed -> Point2 -- ^ End point. -> Point2 -- ^ Start point. -> Point2 -mvPointTowardAtSpeed speed !ep !p +mvPointTowardAtSpeed !speed !ep !p | dist p ep < speed = ep | otherwise = p +.+ speed *.* normalizeV (ep -.- p) {- | given a target and a start point, shift toward the end point by 1. diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs index 5a8025231..455ce60f9 100644 --- a/src/Dodge/LevelGen/AutoDoor.hs +++ b/src/Dodge/LevelGen/AutoDoor.hs @@ -10,6 +10,7 @@ import Dodge.Base import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms import Dodge.Creature.Property +import Dodge.LevelGen.MoveDoor import Geometry import Picture import qualified DoubleStack as DS @@ -103,12 +104,8 @@ autoDoorPane (trigx,trigy) n closedPos openPos = Door = flip (foldr changeZonedWall) zoneps $ over walls (IM.adjust openDoor n) w | otherwise = flip (foldr changeZonedWall') zoneps $ over walls (IM.adjust closeDoor n) w - mvP !ep !p = mvPointTowardAtSpeed 2 ep p - mvPs (ex,ey) (sx,sy) = (mvP ex sx,mvP ey sy) - moveToward :: (Point2,Point2) -> Wall -> Wall - moveToward (ex,ey) wls = wls & wlLine %~ mvPs (ex,ey) - openDoor = moveToward openPos - closeDoor = moveToward closedPos + openDoor = moveDoorToward openPos + closeDoor = moveDoorToward closedPos zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b] | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b changeZonedWall (!x,!y) = over wallsZone $ adjustIMZone openDoor x y n diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 361430b78..a10fc9ddf 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -7,6 +7,7 @@ import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms import Dodge.LevelGen.Switch import Dodge.LevelGen.Pathing +import Dodge.LevelGen.MoveDoor import Picture import Geometry import qualified DoubleStack as DS @@ -162,12 +163,8 @@ triggerDoorPaneLinear c cond n closedPos openPos = Door $ over walls (IM.adjust closeDoor n) w -- . wlLine . ix 0) (mvPointToward a) zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b] | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b - mvP !ep !p = mvPointTowardAtSpeed 2 ep p - mvPs (ex,ey) (sx,sy) = (mvP ex sx,mvP ey sy) - moveToward :: (Point2,Point2) -> Wall -> Wall - moveToward (ex,ey) wls = wls & wlLine %~ mvPs (ex,ey) - openDoor = moveToward openPos - closeDoor = moveToward closedPos + openDoor = moveDoorToward openPos + closeDoor = moveDoorToward closedPos changeZonedWall (!x,!y) = over wallsZone $ adjustIMZone openDoor x y n changeZonedWall' (!x,!y)