justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2026-04-01 19:02:26 +01:00
parent 7a921b8967
commit a7ff096d30
1 changed files with 9 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Link.hs
+9 -12
View File
@@ -21,6 +21,7 @@ import Dodge.RoomLink
import Dodge.ShiftPoint import Dodge.ShiftPoint
import Geometry import Geometry
import RandomHelp import RandomHelp
import Data.Maybe
restrictRMInLinksPD :: ((Point2, Float) -> Bool) -> Room -> Room restrictRMInLinksPD :: ((Point2, Float) -> Bool) -> Room -> Room
restrictRMInLinksPD f = rmLinks %~ restrictLinkType InLink f restrictRMInLinksPD f = rmLinks %~ restrictLinkType InLink f
@@ -46,14 +47,12 @@ shiftRoomBy shift r =
& rmViewpoints . each %~ shiftPointBy shift & rmViewpoints . each %~ shiftPointBy shift
shiftTile :: Point2A -> Tile -> Tile shiftTile :: Point2A -> Tile -> Tile
shiftTile shift tl = case tl ^. tileZeroShift of shiftTile shift tl = tl
Nothing -> tl & tilePoly . each %~ shiftPointBy shift & tilePoly . each %~ shiftPointBy shift
& tileZero %~ shiftPointBy shift & tileZero %~ shiftPointBy s
& tileTangentPos %~ shiftPointBy shift & tileTangentPos %~ shiftPointBy s
Just s -> tl & tilePoly . each %~ shiftPointBy shift where
& tileZero %~ shiftPointBy s s = fromMaybe shift $ tl ^. tileZeroShift
& tileTangentPos %~ shiftPointBy s
moveRoomBy :: (Point2, Float) -> Room -> Room moveRoomBy :: (Point2, Float) -> Room -> Room
moveRoomBy shift r = moveRoomBy shift r =
@@ -75,10 +74,8 @@ moveRoomBy shift r =
shiftRoomShiftToLink :: (Point2, Float) -> (Point2, Float) -> Room -> Room shiftRoomShiftToLink :: (Point2, Float) -> (Point2, Float) -> Room -> Room
shiftRoomShiftToLink l inlink r = shiftRoomShiftToLink l inlink r =
shiftRoomShiftBy l shiftRoomShiftBy l
. shiftRoomShiftBy (V2 0 0, pi - a) . shiftRoomShiftBy (0, pi - a)
$ shiftRoomShiftBy $ shiftRoomShiftBy (0 - p, 0) r
(V2 0 0 -.- p, 0)
r
where where
(p, a) = inlink (p, a) = inlink