This commit is contained in:
2022-06-14 11:35:40 +01:00
parent 4a910566e6
commit 88e5f40f06
6 changed files with 30 additions and 36 deletions
+14 -14
View File
@@ -34,8 +34,8 @@ addGirderNS shapef col room = do
girderPosOrder <- shuffle [1 .. nwestlnks - 2]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -46,23 +46,23 @@ addGirderFromWest fromwesti shapef col room = do
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [fromwesti]]
)
addGirderFrom :: RandomGen g => CardinalPoint -> Int
-> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
addGirderFrom cp fromwesti shapef col room = do
addGirderFrom cp fromi shapef col room = do
let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge cp i))
(isUnusedLnkType (FromEdge cp i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [fromwesti]]
| i <- [fromi]]
)
-- | Allows girder to be on edge
addGirderNS' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
@@ -71,8 +71,8 @@ addGirderNS' shapef col room = do
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -83,8 +83,8 @@ addGirderEW shapef col room = do
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing :
[ twoRoomPoss
(isUnusedLnkType (FromSouth i))
(isUnusedLnkType (FromSouth i))
(isUnusedLnkType (FromEdge South i))
(isUnusedLnkType (FromEdge South i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -94,8 +94,8 @@ addGirder :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> Stat
addGirder shapef col room = do
let nslnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
ewlnks = length $ filter ((OnEdge East `S.member`) . _rlType) $ _rmLinks room
nsgirds = girdson FromEast nslnks
ewgirds = girdson FromNorth ewlnks
nsgirds = girdson (FromEdge East) nslnks
ewgirds = girdson (FromEdge North) ewlnks
girders <- shuffle $ nsgirds ++ ewgirds
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : girders)