diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 5e2b3e8c0..dd4bfff36 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -21,6 +21,7 @@ import Dodge.RoomLink import Dodge.ShiftPoint import Geometry import RandomHelp +import Data.Maybe restrictRMInLinksPD :: ((Point2, Float) -> Bool) -> Room -> Room restrictRMInLinksPD f = rmLinks %~ restrictLinkType InLink f @@ -46,14 +47,12 @@ shiftRoomBy shift r = & rmViewpoints . each %~ shiftPointBy shift shiftTile :: Point2A -> Tile -> Tile -shiftTile shift tl = case tl ^. tileZeroShift of - Nothing -> tl & tilePoly . each %~ shiftPointBy shift - & tileZero %~ shiftPointBy shift - & tileTangentPos %~ shiftPointBy shift - Just s -> tl & tilePoly . each %~ shiftPointBy shift - & tileZero %~ shiftPointBy s - & tileTangentPos %~ shiftPointBy s - +shiftTile shift tl = tl + & tilePoly . each %~ shiftPointBy shift + & tileZero %~ shiftPointBy s + & tileTangentPos %~ shiftPointBy s + where + s = fromMaybe shift $ tl ^. tileZeroShift moveRoomBy :: (Point2, Float) -> Room -> Room moveRoomBy shift r = @@ -75,10 +74,8 @@ moveRoomBy shift r = shiftRoomShiftToLink :: (Point2, Float) -> (Point2, Float) -> Room -> Room shiftRoomShiftToLink l inlink r = shiftRoomShiftBy l - . shiftRoomShiftBy (V2 0 0, pi - a) - $ shiftRoomShiftBy - (V2 0 0 -.- p, 0) - r + . shiftRoomShiftBy (0, pi - a) + $ shiftRoomShiftBy (0 - p, 0) r where (p, a) = inlink