Allow for complex room bounds for clip checks
This commit is contained in:
@@ -4,7 +4,7 @@ Procedural creation of rooms and subroom parts.
|
||||
module Dodge.Room.Procedural
|
||||
( roomRect
|
||||
, roomRectAutoLinks
|
||||
, testRoom
|
||||
, randomFourCornerRoom
|
||||
, centerVaultRoom
|
||||
) where
|
||||
import Dodge.Data
|
||||
@@ -43,7 +43,7 @@ roomRect x y xn yn = Room
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = concatMap doublePair pth
|
||||
, _rmPS = [PS (x/2,y/2) 0 putLamp]
|
||||
, _rmBound = rectNSWE (y+5) (-5) (-5) (x+5)
|
||||
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
|
||||
}
|
||||
where
|
||||
yd = (y - 40) / fromIntegral yn
|
||||
@@ -81,22 +81,17 @@ linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)]
|
||||
linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
|
||||
where
|
||||
linkClosest (p,_) = doublePair (p, minimumBy (compare `on` dist p) $ map fst subpth)
|
||||
|
||||
{- Combines two rooms into one room.
|
||||
Combines into one big bound, concatenates the rest.
|
||||
-}
|
||||
Combines into one big bound, concatenates the rest. -}
|
||||
combineRooms :: Room -> Room -> Room
|
||||
combineRooms r r' = Room
|
||||
{ _rmPolys = _rmPolys r ++ _rmPolys r'
|
||||
, _rmLinks = _rmLinks r ++ _rmLinks r'
|
||||
, _rmPath = _rmPath r ++ _rmPath r'
|
||||
, _rmPS = _rmPS r ++ _rmPS r'
|
||||
, _rmBound = convexHull . nubBy (\a b -> dist a b < 5) $ _rmBound r ++ _rmBound r'
|
||||
, _rmBound = _rmBound r ++ _rmBound r'
|
||||
}
|
||||
|
||||
{-
|
||||
The top fourth of a room of a given height.
|
||||
-}
|
||||
{- The top fourth of a room of a given height. -}
|
||||
fourth
|
||||
:: Float -- ^ Distance from center of room to top edge
|
||||
-> Room
|
||||
@@ -107,24 +102,13 @@ fourth w = Room
|
||||
, _rmPS =
|
||||
[PS (0,w/2) 0 putLamp
|
||||
]
|
||||
, _rmBound = [(w,w),(-w,w)]
|
||||
, _rmBound = [[(0,0),(w,w),(-w,w)]]
|
||||
}
|
||||
|
||||
{-
|
||||
Randomly generate a top fourth of a room possibly with a wall.
|
||||
Add a light and a 'PutNothing' placement.
|
||||
-}
|
||||
{- Randomly generate a top fourth of a room possibly with a wall.
|
||||
Add a light and a 'PutNothing' placement. -}
|
||||
fourthWall :: RandomGen g => Float -> State g Room
|
||||
fourthWall w = do
|
||||
b <- takeOne
|
||||
--[ [ PS (20-w,w-40) 0 putLamp
|
||||
-- , PS (w-20,w-40) pi PutNothing
|
||||
-- ]
|
||||
-- [ [ PS (20-w,w-40) 0 putLamp
|
||||
-- , PS (0,40) 0 putLamp
|
||||
-- , PS (w-20,w-40) pi PutNothing
|
||||
-- , blockLine (w/2,w) (negate $ w/2,w/2)
|
||||
-- ]
|
||||
[ [ PS (20-w,w-40) 0 putLamp
|
||||
, PS (0,40) 0 putLamp
|
||||
, PS (w-20,w-20) pi PutNothing
|
||||
@@ -147,7 +131,7 @@ fourthWall w = do
|
||||
, _rmLinks = [((0,w), 0)]
|
||||
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
|
||||
, _rmPS = b
|
||||
, _rmBound = [(w,w),(-w,w)]
|
||||
, _rmBound = [[(0,0),(w,w),(-w,w)]]
|
||||
}
|
||||
|
||||
fourthCorner :: Float -> Room
|
||||
@@ -159,7 +143,7 @@ fourthCorner w = Room
|
||||
]
|
||||
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
|
||||
, _rmPS = [PS (0,w) 0 putLamp]
|
||||
, _rmBound = [(w,w),(0,2*w),(-w,w)]
|
||||
, _rmBound = [[(w,w),(0,2*w),(-w,w)]]
|
||||
}
|
||||
|
||||
fourthCornerWall :: RandomGen g => Float -> State g Room
|
||||
@@ -196,9 +180,9 @@ fourthCornerWall w = do
|
||||
]
|
||||
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
|
||||
, _rmPS = b
|
||||
, _rmBound = [(w,w),(0,2*w),(-w,w)]
|
||||
, _rmBound = [[(w,w),(0,2*w),(-w,w)]]
|
||||
}
|
||||
|
||||
{- | Replace the first 'PutNothing' with a given 'PSType'. -}
|
||||
fillNothingPlacement :: PSType -> Room -> Room
|
||||
fillNothingPlacement pst r =
|
||||
r & rmPS %~ replaceNothingWith pst
|
||||
@@ -206,17 +190,20 @@ fillNothingPlacement pst r =
|
||||
replaceNothingWith x (PS p rot PutNothing: pss) = PS p rot x : pss
|
||||
replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
|
||||
replaceNothingWith _ [] = []
|
||||
|
||||
{- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
|
||||
-}
|
||||
fillNothingPlacements :: [PSType] -> Room -> Room
|
||||
fillNothingPlacements pst r = foldr fillNothingPlacement r pst
|
||||
|
||||
{- | Randomise the ordering of placements in a room.
|
||||
Useful for randomising the position of generic placements such as 'PutNothing'. -}
|
||||
shufflePlacements :: RandomGen g => Room -> State g Room
|
||||
shufflePlacements r = do
|
||||
newPSs <- shuffle $ _rmPS r
|
||||
return $ r & rmPS .~ newPSs
|
||||
|
||||
testRoom :: RandomGen g => State g Room
|
||||
testRoom = do
|
||||
{- | A randomly generate room based on four randomly generated corners.
|
||||
Tight corridors, random placements. -}
|
||||
randomFourCornerRoom :: RandomGen g => State g Room
|
||||
randomFourCornerRoom = do
|
||||
corners <- replicateM 4 . join $ takeOne [fourthWall 100, fourthCornerWall 100]
|
||||
nItms <- state $ randomR (1,2)
|
||||
itms <- takeN nItms $ fmap PutFlIt $ [autoRadar,autoSonar,remoteLauncher,jetPack,blinkGun] ++ replicate 5 (medkit 500)
|
||||
@@ -228,7 +215,6 @@ testRoom = do
|
||||
. foldr1 combineRooms
|
||||
$ zipWith (\r a -> shiftRoomBy ((0,0),a) r) corners [0,pi/2,pi,3*pi/2]
|
||||
)
|
||||
|
||||
{- | Creates room with a central vault with doors around it.
|
||||
-}
|
||||
centerVaultRoom
|
||||
@@ -268,7 +254,7 @@ centerVaultRoom n w h d = do
|
||||
]
|
||||
++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i)
|
||||
[n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
|
||||
, _rmBound = rectNSWE h (-h) (-w) w
|
||||
, _rmBound = [rectNSWE h (-h) (-w) w]
|
||||
}
|
||||
where
|
||||
col = dim $ dim $ bright red
|
||||
|
||||
Reference in New Issue
Block a user