Nub close points for game room boundaries
This commit is contained in:
@@ -66,7 +66,7 @@ shiftRoomBy :: (Point2,Float) -> Room -> Room
|
||||
shiftRoomBy shift r = r
|
||||
& rmPolys %~ fmap (map (shiftPointBy shift))
|
||||
& rmLinks %~ fmap (shiftLinkBy shift)
|
||||
& rmPath %~ map (shiftPathPointBy shift)
|
||||
& rmPath %~ map (shiftPathBy shift)
|
||||
& rmBound %~ fmap (map (shiftPointBy shift))
|
||||
& rmShift %~ shiftLinkBy shift
|
||||
& rmFloor %~ map
|
||||
@@ -82,8 +82,8 @@ shiftLinkBy
|
||||
-> (Point2,Float)
|
||||
shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
|
||||
|
||||
shiftPathPointBy
|
||||
shiftPathBy
|
||||
:: (Point2,Float)
|
||||
-> (Point2,Point2)
|
||||
-> (Point2,Point2)
|
||||
shiftPathPointBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
|
||||
shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
|
||||
|
||||
@@ -69,51 +69,35 @@ roomRect x y xn yn = defaultRoom
|
||||
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -}
|
||||
roomRectAutoLinks :: Float -> Float -> Room
|
||||
roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
|
||||
|
||||
|
||||
{- Combines two rooms into one room.
|
||||
Combines into one big bound, concatenates the rest. -}
|
||||
combineRooms :: Room -> Room -> Room
|
||||
combineRooms r r' = defaultRoom
|
||||
{ _rmPolys = _rmPolys r ++ _rmPolys r'
|
||||
, _rmLinks = _rmLinks r ++ _rmLinks r'
|
||||
, _rmPath = _rmPath r ++ _rmPath r'
|
||||
, _rmPath = map (shiftPathBy $ _rmShift r) (_rmPath r )
|
||||
++ map (shiftPathBy $ _rmShift r') (_rmPath r')
|
||||
, _rmPS = map (shiftPlacement $ _rmShift r) (_rmPS r)
|
||||
++ map (shiftPlacement $ _rmShift r') (_rmPS r')
|
||||
, _rmBound = _rmBound r ++ _rmBound r'
|
||||
, _rmFloor = _rmFloor r ++ _rmFloor r'
|
||||
, _rmShift = (V2 0 0 , 0)
|
||||
}
|
||||
--{- The top fourth of a room of a given height. -}
|
||||
--fourth
|
||||
-- :: Float -- ^ Distance from center of room to top edge
|
||||
-- -> Room
|
||||
--fourth w = Room
|
||||
-- { _rmPolys = [ [(0,0),(w,w),(-w,w)] ]
|
||||
-- , _rmLinks = [((0,w), 0)]
|
||||
-- , _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
|
||||
-- , _rmPS =
|
||||
-- [sPS (0,w/2) 0 putLamp
|
||||
-- ]
|
||||
-- , _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. -}
|
||||
fourthWall :: RandomGen g => Float -> State g Room
|
||||
fourthWall w = do
|
||||
quarterRoomFlat :: RandomGen g => Float -> State g Room
|
||||
quarterRoomFlat w = do
|
||||
b <- takeOne
|
||||
[ [ sPS (V2 (20-w) (w-40)) 0 putLamp
|
||||
, sPS (V2 0 40) 0 putLamp
|
||||
[ [ mountedLightV (V2 0 w) (V3 0 (w-20) 70)
|
||||
, mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, sPS (V2 (w-20) (w-20)) pi PutNothing
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
|
||||
]
|
||||
, [ sPS (V2 (20-w) (w-40)) 0 putLamp
|
||||
, sPS (V2 0 40) 0 putLamp
|
||||
, [ mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, sPS (V2 (w-20) (w-20)) pi PutNothing
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))
|
||||
]
|
||||
, [ sPS (V2 (20-w) (w-40)) 0 putLamp
|
||||
, sPS (V2 0 20) 0 putLamp
|
||||
, [ mountedLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
|
||||
, sPS (V2 (w-20) (w-20)) pi PutNothing
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
|
||||
, blockLine (V2 (-29) w) (V2 0 (w/2))
|
||||
@@ -130,27 +114,20 @@ fourthWall w = do
|
||||
fourthCornerWall :: RandomGen g => Float -> State g Room
|
||||
fourthCornerWall w = do
|
||||
b <- takeOne
|
||||
[ [ sPS (V2 (10-w) w) 0 putLamp
|
||||
, sPS (V2 (w-10) w) 0 putLamp
|
||||
, sPS (V2 0 10) 0 putLamp
|
||||
, sPS (V2 0 (2*w-20)) pi PutNothing
|
||||
[ [ mountedLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
|
||||
, blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
|
||||
, sPS (V2 20 (2*w-40)) pi PutNothing
|
||||
]
|
||||
, [ sPS (V2 0 (3*w/2)) 0 putLamp
|
||||
, sPS (V2 (w-10) w) 0 putLamp
|
||||
, sPS (V2 (10-w) (w-20) ) 0 putLamp
|
||||
, sPS (V2 0 10 ) 0 putLamp
|
||||
, sPS (V2 0 (2*w-20)) pi PutNothing
|
||||
, [ mountedLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
|
||||
, blockLine (V2 (negate w) w ) (V2 0 w)
|
||||
]
|
||||
, [ sPS (V2 (10-w) w ) 0 putLamp
|
||||
, sPS (V2 (w-10) w ) 0 putLamp
|
||||
, sPS (V2 0 10 ) 0 putLamp
|
||||
, sPS (V2 20 (2*w-40)) pi PutNothing
|
||||
]
|
||||
, [ mountedLight (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
|
||||
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
|
||||
, blockLine (V2 0 w) (V2 0 (w*2))
|
||||
, sPS (V2 20 (2*w-40)) pi PutNothing
|
||||
]
|
||||
]
|
||||
pure $ defaultRoom
|
||||
@@ -159,7 +136,9 @@ fourthCornerWall w = do
|
||||
[(V2 (w/2) (3*w/2), negate $ pi/4)
|
||||
,(V2 (negate $ w/2) (3*w/2), pi/4)
|
||||
]
|
||||
, _rmPath = [(V2 0 w,V2 0 0),(V2 0 0,V2 0 w)]
|
||||
, _rmPath = [(V2 0 0,V2 w 0)
|
||||
,(V2 0 0,V2 w w)
|
||||
]
|
||||
, _rmPS = b
|
||||
, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
|
||||
}
|
||||
@@ -185,7 +164,7 @@ shufflePlacements r = do
|
||||
Tight corridors, random placements. -}
|
||||
randomFourCornerRoom :: RandomGen g => State g Room
|
||||
randomFourCornerRoom = do
|
||||
corners <- replicateM 4 . join $ takeOne [fourthWall 100, fourthCornerWall 100]
|
||||
corners <- replicateM 4 . join $ takeOne [quarterRoomFlat 100, fourthCornerWall 100]
|
||||
nItms <- state $ randomR (1,2)
|
||||
itms <- takeN nItms $ fmap PutFlIt $ [autoRadar,autoSonar,remoteLauncher,jetPack,blinkGun] ++ replicate 5 (medkit 500)
|
||||
nCrits <- state $ randomR (1,3)
|
||||
@@ -193,11 +172,11 @@ randomFourCornerRoom = do
|
||||
++ replicate 20 chaseCrit
|
||||
randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<<
|
||||
( shufflePlacements
|
||||
. over rmPS ( sps0 putLamp :)
|
||||
. foldr1 combineRooms
|
||||
$ zipWith (\r a -> shiftRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
|
||||
)
|
||||
{- | Creates room with a central vault with doors around it.
|
||||
-}
|
||||
{- | Creates room with a central vault with doors around it. -}
|
||||
centerVaultRoom
|
||||
:: Float -- ^ Width
|
||||
-> Float -- ^ Height
|
||||
@@ -214,20 +193,16 @@ centerVaultRoom w h d = do
|
||||
]
|
||||
, _rmPath = []
|
||||
, _rmPS =
|
||||
[sps0 $ PutWall (rectNSEW ( d) (d - 30) ( d) (d - 30)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW ( d) (d - 30) (-d) (30 - d)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW (-d) (30 - d) ( d) (d - 30)) defaultWall
|
||||
[sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
|
||||
-- ,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
|
||||
,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
|
||||
-- ,mountedLight (V2 (-w) (h/2-20)) (V3 (20-w) (h/2-20) 70)
|
||||
-- ,mountedLight (V2 w (h/2-20)) (V3 (w-20) (h/2-20) 70)
|
||||
-- ,mountedLightV (V2 0 (d-20)) (V3 0 0 70)
|
||||
]
|
||||
++ map (\a -> mountedLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
|
||||
[0,0.5*pi,pi,1.5*pi]
|
||||
++ concat (map (\r -> map (shiftPlacement (V2 0 0,r)) $ theDoor)
|
||||
[0,pi/2,pi,3*pi/2])
|
||||
++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor)
|
||||
[0,pi/2,pi,3*pi/2]
|
||||
, _rmBound = [rectNSWE h (-h) (-w) w]
|
||||
}
|
||||
where
|
||||
@@ -235,8 +210,6 @@ centerVaultRoom w h d = do
|
||||
theDoor =
|
||||
[ Placement (PS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red id id)
|
||||
$ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
|
||||
$ sPS (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2 21 0) (V2 0 0) 2)
|
||||
$ sPS (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2 21 0) (V2 0 0) 2)
|
||||
]
|
||||
--cond i w' = or $ M.lookup (DoorNumOpen i) (_worldState w')
|
||||
cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
|
||||
|
||||
|
||||
Reference in New Issue
Block a user