Add support for group placements
This commit is contained in:
+14
-14
@@ -22,9 +22,9 @@ airlockOneWay n = Room
|
||||
{ _rmPolys = [rectNSWE 90 0 0 40]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = []
|
||||
, _rmPS = [PS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40)
|
||||
,PS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40)
|
||||
,PS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState
|
||||
, _rmPS = [sPS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40)
|
||||
,sPS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40)
|
||||
,sPS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState
|
||||
(M.insert (DoorNumOpen n) True))
|
||||
]
|
||||
--, _rmBound = rectNSWE 90 30 (-30) 30
|
||||
@@ -59,12 +59,12 @@ airlock0 n = Room
|
||||
,((20,45),(20, 5))
|
||||
]
|
||||
, _rmPS =
|
||||
[PS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0)
|
||||
,PS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0)
|
||||
,PS (35,50) (pi/2) $ PutButton $ makeSwitch col
|
||||
[sPS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0)
|
||||
,sPS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0)
|
||||
,sPS (35,50) (pi/2) $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen n) True))
|
||||
(over worldState (M.insert (DoorNumOpen n) False))
|
||||
,PS (-25, 50) 0 putLamp
|
||||
,sPS (-25, 50) 0 putLamp
|
||||
]
|
||||
, _rmBound = [rectNSWE 75 15 0 40]
|
||||
}
|
||||
@@ -98,11 +98,11 @@ airlock90 n = Room
|
||||
,((40,0),(0,40))
|
||||
]
|
||||
, _rmPS =
|
||||
[PS (5,5) 0 $ PutDoor col (not . cond) pss
|
||||
,PS (120,120) (3* pi/4) $ PutButton $ makeSwitch col
|
||||
[sPS (5,5) 0 $ PutDoor col (not . cond) pss
|
||||
,sPS (120,120) (3* pi/4) $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen n) True))
|
||||
(over worldState (M.insert (DoorNumOpen n) False))
|
||||
,PS (60, 60) 0 putLamp
|
||||
,sPS (60, 60) 0 putLamp
|
||||
]
|
||||
, _rmBound =
|
||||
[[ (10,10)
|
||||
@@ -138,13 +138,13 @@ airlockCrystal n = Room
|
||||
[
|
||||
]
|
||||
, _rmPS =
|
||||
[PS (0,0) 0 $ PutDoor col (not . cond) pss
|
||||
,PS (145,70) (pi/2) $ PutButton $ makeSwitch col
|
||||
[sPS (0,0) 0 $ PutDoor col (not . cond) pss
|
||||
,sPS (145,70) (pi/2) $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen n) True))
|
||||
(over worldState (M.insert (DoorNumOpen n) False))
|
||||
,crystalLine (0,70) (40,70)
|
||||
,PS (20, 40) 0 putLamp
|
||||
,PS (20, 100) 0 putLamp
|
||||
,sPS (20, 40) 0 putLamp
|
||||
,sPS (20, 100) 0 putLamp
|
||||
]
|
||||
, _rmBound =
|
||||
[ ]
|
||||
|
||||
+12
-12
@@ -34,10 +34,10 @@ roomGlassOctogon x = Room
|
||||
, _rmPath = [((0,x),(0,-(x+40)))
|
||||
,((0,-(x+40)),(0,x))]
|
||||
, _rmPS =
|
||||
[PS (fx,fx) 0 putLamp
|
||||
,PS (-fx,fx) 0 putLamp
|
||||
,PS (fx,-fx) 0 putLamp
|
||||
,PS (-fx,-fx) 0 putLamp
|
||||
[sPS (fx,fx) 0 putLamp
|
||||
,sPS (-fx,fx) 0 putLamp
|
||||
,sPS (fx,-fx) 0 putLamp
|
||||
,sPS (-fx,-fx) 0 putLamp
|
||||
,crystalLine (-x,x/2) (negate (x/2), x)
|
||||
,crystalLine (x,x/2) (x/2, x)
|
||||
,crystalLine (x/2,-x) (x,negate (x/2))
|
||||
@@ -50,13 +50,13 @@ roomGlassOctogon x = Room
|
||||
fx = 4 * x / 5
|
||||
|
||||
bossRoom :: RandomGen g => Creature -> State g Room
|
||||
bossRoom cr = randomMediumRoom <&> rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
|
||||
bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (0,100) (negate $ pi/2) (PutCrit cr) :)
|
||||
|
||||
armouredChasers :: RandomGen g => State g (Tree Room)
|
||||
armouredChasers = do
|
||||
ps <- takeN 5 [(x,y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
|
||||
as <- replicateM 5 . state $ randomR (0,2*pi)
|
||||
let theCrits = zipWith3 (\p a c -> PS p a (PutCrit c)) ps as cs
|
||||
let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs
|
||||
treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits))
|
||||
where
|
||||
cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0])
|
||||
@@ -90,10 +90,10 @@ roomCross x y = Room
|
||||
]
|
||||
, _rmPath = []
|
||||
, _rmPS =
|
||||
[PS ( x, 0) 0 putLamp
|
||||
,PS (-x, 0) 0 putLamp
|
||||
,PS ( 0, x) 0 putLamp
|
||||
,PS ( 0,-x) 0 putLamp
|
||||
[sPS ( x, 0) 0 putLamp
|
||||
,sPS (-x, 0) 0 putLamp
|
||||
,sPS ( 0, x) 0 putLamp
|
||||
,sPS ( 0,-x) 0 putLamp
|
||||
]
|
||||
, _rmBound =
|
||||
[rectNSWE y (-y) (-x) x
|
||||
@@ -116,7 +116,7 @@ roomShuriken x y =
|
||||
{ _rmPolys = ps
|
||||
, _rmLinks = [((x-1,y-20),negate $ pi/2)]
|
||||
, _rmPath = []
|
||||
, _rmPS = [PS (x/2,x/2) 0 putLamp]
|
||||
, _rmPS = [sPS (x/2,x/2) 0 putLamp]
|
||||
, _rmBound = ps
|
||||
}
|
||||
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
|
||||
@@ -140,7 +140,7 @@ roomTwistCross x y z =
|
||||
{ _rmPolys = ps
|
||||
, _rmLinks = [((z,y-20), pi/2)]
|
||||
, _rmPath = []
|
||||
, _rmPS = [PS (x/2,x/2) 0 putLamp]
|
||||
, _rmPS = [sPS (x/2,x/2) 0 putLamp]
|
||||
, _rmBound = ps
|
||||
}
|
||||
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
|
||||
|
||||
@@ -20,7 +20,7 @@ data Room = Room
|
||||
{ _rmPolys :: [ [Point2] ]
|
||||
, _rmLinks :: [(Point2,Float)]
|
||||
, _rmPath :: [(Point2, Point2)]
|
||||
, _rmPS :: [PlacementSpot]
|
||||
, _rmPS :: [Placement]
|
||||
, _rmBound :: [ [Point2] ]
|
||||
}
|
||||
makeLenses ''Room
|
||||
|
||||
@@ -16,7 +16,7 @@ door = Room
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = [((20,35),(20,5))]
|
||||
-- door extends into side walls (for shadows as rendered 12/03)
|
||||
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
|
||||
, _rmPS = [sPS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
|
||||
, _rmBound = []
|
||||
}
|
||||
where lnks = [((20,35),0)
|
||||
|
||||
@@ -73,9 +73,13 @@ shiftRoomBy shift@(pos,rot) r =
|
||||
r
|
||||
|
||||
shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
|
||||
shiftPSBy (pos,rot) ps = case ps of
|
||||
PS {} -> over psPos (shiftPointBy (pos,rot))
|
||||
$ over psRot (+rot)
|
||||
ps
|
||||
shiftPSBy (pos,rot) ps = ps
|
||||
& placementSpot . psPos %~ shiftPointBy (pos,rot)
|
||||
& placementSpot . psRot %~ (+ rot)
|
||||
|
||||
--shiftPSBy (pos,rot) ps = case ps of
|
||||
-- PS {} -> over psPos (shiftPointBy (pos,rot))
|
||||
-- $ over psRot (+rot)
|
||||
-- ps
|
||||
|
||||
shiftPathPointBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
|
||||
|
||||
+11
-11
@@ -38,12 +38,12 @@ twinSlowDoorRoom drID w h x = Room
|
||||
]
|
||||
, _rmPath = []
|
||||
, _rmPS =
|
||||
[ PS (0,h/2) 0 putLamp
|
||||
, PS (25,5) 0 putLamp
|
||||
, PS (negate 25,5) 0 putLamp
|
||||
, PS (0,0) 0 $ PutDoor col (not . cond) drL
|
||||
, PS (0,0) 0 $ PutDoor col (not . cond) drR
|
||||
, PS (0,h-5) pi $ PutButton $ makeButton col
|
||||
[ sPS (0,h/2) 0 putLamp
|
||||
, sPS (25,5) 0 putLamp
|
||||
, sPS (negate 25,5) 0 putLamp
|
||||
, sPS (0,0) 0 $ PutDoor col (not . cond) drL
|
||||
, sPS (0,0) 0 $ PutDoor col (not . cond) drR
|
||||
, sPS (0,h-5) pi $ PutButton $ makeButton col
|
||||
(over worldState (M.insert (DoorNumOpen drID) True))
|
||||
]
|
||||
, _rmBound = ps
|
||||
@@ -69,7 +69,7 @@ twinSlowDoorChasers drid = do
|
||||
let lps = (-65 ,) <$> [20,40 .. 180]
|
||||
rps = (65 ,) <$> [20,40 .. 180]
|
||||
ps <- takeN 4 $ lps ++ rps
|
||||
let plmnts = map (\p -> PS p 0 $ PutCrit chaseCrit) ps
|
||||
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
|
||||
return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
|
||||
|
||||
slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
@@ -88,9 +88,9 @@ slowDoorRoom = do
|
||||
let ps = zip xs ys
|
||||
xs' <- replicateM 5 $ state $ randomR (10,x-10)
|
||||
ys' <- replicateM 5 $ state $ randomR (h+20,y)
|
||||
let crits = zipWith (\p r -> PS p r randC1) ps rs
|
||||
lsources = [PS (x/2,30) 0 putLamp, PS (x/2,y-30) 0 putLamp]
|
||||
barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
|
||||
let crits = zipWith (\p r -> sPS p r randC1) ps rs
|
||||
lsources = [sPS (x/2,30) 0 putLamp, sPS (x/2,y-30) 0 putLamp]
|
||||
barrels = zipWith (\x y -> sPS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
|
||||
pillarsa = []
|
||||
pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20)
|
||||
@@ -107,7 +107,7 @@ slowDoorRoom = do
|
||||
fmap connectRoom
|
||||
(filterLinks cond =<<
|
||||
changeLinkTo cond2
|
||||
(set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
|
||||
(set rmPS ([sPS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
|
||||
$ roomRectAutoLinks x y
|
||||
)
|
||||
)
|
||||
|
||||
@@ -29,11 +29,11 @@ centerVaultExplosiveExit
|
||||
centerVaultExplosiveExit drID = do
|
||||
cr <- takeOne [miniGunCrit, autoCrit]
|
||||
let extraPS =
|
||||
[PS (0,175) 0 $ PutCrit explosiveBarrel
|
||||
,PS (5,195) 0 $ PutCrit explosiveBarrel
|
||||
,PS (0,200) 0 $ PutCrit explosiveBarrel
|
||||
,PS (-4,195) 0 $ PutCrit explosiveBarrel
|
||||
,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
|
||||
[sPS (0,175) 0 $ PutCrit explosiveBarrel
|
||||
,sPS (5,195) 0 $ PutCrit explosiveBarrel
|
||||
,sPS (0,200) 0 $ PutCrit explosiveBarrel
|
||||
,sPS (-4,195) 0 $ PutCrit explosiveBarrel
|
||||
,sPS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
|
||||
]
|
||||
r <- centerVaultRoom drID 200 200 50 <&> rmPS %~ (extraPS ++)
|
||||
randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2
|
||||
|
||||
+12
-12
@@ -15,15 +15,15 @@ import Control.Lens
|
||||
|
||||
putLamp = PutCrit lamp
|
||||
|
||||
singleBlock :: Point2 -> [PlacementSpot]
|
||||
singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5)
|
||||
singleBlock :: Point2 -> [Placement]
|
||||
singleBlock a = [sPS a 0 $ PutBlock [5,20,20] (greyN 0.5)
|
||||
$ reverse $ rectNSWE 10 (-10) (-10) 10]
|
||||
{-
|
||||
Places a line of blocks between two points.
|
||||
Width 9, also extends out from each point by 9.
|
||||
-}
|
||||
blockLine :: Point2 -> Point2 -> PlacementSpot
|
||||
blockLine a b = PS
|
||||
blockLine :: Point2 -> Point2 -> Placement
|
||||
blockLine a b = SinglePlacement $ PS
|
||||
{ _psPos = (0,0)
|
||||
, _psRot = 0
|
||||
, _psType = PutLineBlock baseBlockPane 9 9 a b
|
||||
@@ -33,8 +33,8 @@ blockLine a b = PS
|
||||
Places an breakable window between two points.
|
||||
Width 8, also extends out from each point by 8.
|
||||
-}
|
||||
windowLine :: Point2 -> Point2 -> PlacementSpot
|
||||
windowLine a b = PS
|
||||
windowLine :: Point2 -> Point2 -> Placement
|
||||
windowLine a b = SinglePlacement $ PS
|
||||
{ _psPos = (0,0)
|
||||
, _psRot = 0
|
||||
, _psType = PutLineBlock baseWindowPane 8 8 a b
|
||||
@@ -44,8 +44,8 @@ windowLine a b = PS
|
||||
Places an unbreakable window between two points.
|
||||
Width 7, also extends out from each point by 7.
|
||||
-}
|
||||
crystalLine :: Point2 -> Point2 -> PlacementSpot
|
||||
crystalLine a b = PS
|
||||
crystalLine :: Point2 -> Point2 -> Placement
|
||||
crystalLine a b = SinglePlacement $ PS
|
||||
{ _psPos = (0,0)
|
||||
, _psRot = 0
|
||||
, _psType = PutWall ps defaultCrystalWall
|
||||
@@ -62,8 +62,8 @@ crystalLine a b = PS
|
||||
{- Places an unbreakable wall between two points.
|
||||
Depth 15, does not extend wider than points.
|
||||
-}
|
||||
wallLine :: Point2 -> Point2 -> PlacementSpot
|
||||
wallLine a b = PS
|
||||
wallLine :: Point2 -> Point2 -> Placement
|
||||
wallLine a b = SinglePlacement $ PS
|
||||
{ _psPos = (0,0)
|
||||
, _psRot = 0
|
||||
, _psType = PutWall ps defaultWall
|
||||
@@ -114,7 +114,7 @@ replacePutID
|
||||
-> Room
|
||||
-> Room
|
||||
replacePutID i psts r =
|
||||
r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts
|
||||
r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & placementSpot . psType .~ pt)) psts
|
||||
{- Partition a list by a predicate, apply a zip to those elements
|
||||
that satisfy the predicate, concatenate
|
||||
the new zipped list and the other (unchanged) half. -}
|
||||
@@ -128,7 +128,7 @@ subZipWith f g xs ys =
|
||||
let (zs,ws) = partition f xs
|
||||
in zipWith g zs ys ++ ws
|
||||
|
||||
isPutID i ps = Just i == ps ^? psType . putID
|
||||
isPutID i ps = Just i == ps ^? placementSpot . psType . putID
|
||||
|
||||
putBlockRect a x b y = [ blockLine (a,b) (a,y)
|
||||
, blockLine (a,y) (x,y)
|
||||
|
||||
@@ -43,7 +43,7 @@ roomRect x y xn yn = Room
|
||||
{ _rmPolys = [rectNSWE y 0 0 x ]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = concatMap doublePair pth
|
||||
, _rmPS = [PS (x/2,y/2) 0 putLamp]
|
||||
, _rmPS = [sPS (x/2,y/2) 0 putLamp]
|
||||
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
|
||||
}
|
||||
where
|
||||
@@ -103,7 +103,7 @@ fourth w = Room
|
||||
, _rmLinks = [((0,w), 0)]
|
||||
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
|
||||
, _rmPS =
|
||||
[PS (0,w/2) 0 putLamp
|
||||
[sPS (0,w/2) 0 putLamp
|
||||
]
|
||||
, _rmBound = [[(0,0),(w,w),(-w,w)]]
|
||||
}
|
||||
@@ -112,19 +112,19 @@ 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 (0,40) 0 putLamp
|
||||
, PS (w-20,w-20) pi PutNothing
|
||||
[ [ sPS (20-w,w-40) 0 putLamp
|
||||
, sPS (0,40) 0 putLamp
|
||||
, sPS (w-20,w-20) pi PutNothing
|
||||
, blockLine (w/2,w/2) (w/2,w)
|
||||
]
|
||||
, [ PS (20-w,w-40) 0 putLamp
|
||||
, PS (0,40) 0 putLamp
|
||||
, PS (w-20,w-20) pi PutNothing
|
||||
, [ sPS (20-w,w-40) 0 putLamp
|
||||
, sPS (0,40) 0 putLamp
|
||||
, sPS (w-20,w-20) pi PutNothing
|
||||
, blockLine (w/2,w/2) (negate $ w/2,w/2)
|
||||
]
|
||||
, [ PS (20-w,w-40) 0 putLamp
|
||||
, PS (0,20) 0 putLamp
|
||||
, PS (w-20,w-20) pi PutNothing
|
||||
, [ sPS (20-w,w-40) 0 putLamp
|
||||
, sPS (0,20) 0 putLamp
|
||||
, sPS (w-20,w-20) pi PutNothing
|
||||
, blockLine (w/2,w/2) (0,w/2)
|
||||
, blockLine (-29,w) (0,w/2)
|
||||
]
|
||||
@@ -145,32 +145,32 @@ fourthCorner w = Room
|
||||
,((negate $ w/2,3*w/2), pi/4)
|
||||
]
|
||||
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
|
||||
, _rmPS = [PS (0,w) 0 putLamp]
|
||||
, _rmPS = [sPS (0,w) 0 putLamp]
|
||||
, _rmBound = [[(w,w),(0,2*w),(-w,w)]]
|
||||
}
|
||||
|
||||
fourthCornerWall :: RandomGen g => Float -> State g Room
|
||||
fourthCornerWall w = do
|
||||
b <- takeOne
|
||||
[ [ PS (10-w,w) 0 putLamp
|
||||
, PS (w-10,w) 0 putLamp
|
||||
, PS (0,10) 0 putLamp
|
||||
, PS (0,2*w-20) pi PutNothing
|
||||
[ [ sPS (10-w,w) 0 putLamp
|
||||
, sPS (w-10,w) 0 putLamp
|
||||
, sPS (0,10) 0 putLamp
|
||||
, sPS (0,2*w-20) pi PutNothing
|
||||
, blockLine (w/2,w/2) (0,w)
|
||||
, blockLine (negate $ w/2,w/2) (0,w)
|
||||
]
|
||||
, [ PS (0,3*w/2) 0 putLamp
|
||||
, PS (w-10,w) 0 putLamp
|
||||
, PS (10-w,w-20) 0 putLamp
|
||||
, PS (0,10) 0 putLamp
|
||||
, PS (0,2*w-20) pi PutNothing
|
||||
, [ sPS (0,3*w/2) 0 putLamp
|
||||
, sPS (w-10,w) 0 putLamp
|
||||
, sPS (10-w,w-20) 0 putLamp
|
||||
, sPS (0,10) 0 putLamp
|
||||
, sPS (0,2*w-20) pi PutNothing
|
||||
, blockLine (w/2,w/2) (0,w)
|
||||
, blockLine (negate w,w) (0,w)
|
||||
]
|
||||
, [ PS (10-w,w) 0 putLamp
|
||||
, PS (w-10,w) 0 putLamp
|
||||
, PS (0,10) 0 putLamp
|
||||
, PS (20,2*w-40) pi PutNothing
|
||||
, [ sPS (10-w,w) 0 putLamp
|
||||
, sPS (w-10,w) 0 putLamp
|
||||
, sPS (0,10) 0 putLamp
|
||||
, sPS (20,2*w-40) pi PutNothing
|
||||
, blockLine (w/2,w/2) (0,w)
|
||||
, blockLine (0,w) (0,w*2)
|
||||
]
|
||||
@@ -190,7 +190,7 @@ fillNothingPlacement :: PSType -> Room -> Room
|
||||
fillNothingPlacement pst r =
|
||||
r & rmPS %~ replaceNothingWith pst
|
||||
where
|
||||
replaceNothingWith x (PS p rot PutNothing: pss) = PS p rot x : pss
|
||||
replaceNothingWith x (SinglePlacement (PS p rot PutNothing): pss) = sPS p rot x : pss
|
||||
replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
|
||||
replaceNothingWith _ [] = []
|
||||
{- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
|
||||
@@ -243,11 +243,11 @@ centerVaultRoom n w h d = do
|
||||
]
|
||||
, _rmPath = []
|
||||
, _rmPS =
|
||||
[PS (d-25,d-25) 0 putLamp
|
||||
,PS (w-5,h-5) 0 putLamp
|
||||
,PS (w-5,5-h) 0 putLamp
|
||||
,PS (5-w,h-5) 0 putLamp
|
||||
,PS (5-w,5-h) 0 putLamp
|
||||
[sPS (d-25,d-25) 0 putLamp
|
||||
,sPS (w-5,h-5) 0 putLamp
|
||||
,sPS (w-5,5-h) 0 putLamp
|
||||
,sPS (5-w,h-5) 0 putLamp
|
||||
,sPS (5-w,5-h) 0 putLamp
|
||||
]
|
||||
++ 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])
|
||||
@@ -256,8 +256,8 @@ centerVaultRoom n w h d = do
|
||||
where
|
||||
col = dim $ dim $ bright red
|
||||
theDoor i =
|
||||
[ PS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0)
|
||||
, PS (35,d+4) 0 $ PutButton $ makeSwitch col
|
||||
[ sPS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0)
|
||||
, sPS (35,d+4) 0 $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen i) True))
|
||||
(over worldState (M.insert (DoorNumOpen i) False))
|
||||
]
|
||||
|
||||
@@ -40,12 +40,12 @@ litCorridor90 = do
|
||||
,((40,h-40),(20,h-40))
|
||||
]
|
||||
, _rmPS =
|
||||
[ PS (20,h-5) 0 putLamp
|
||||
[ sPS (20,h-5) 0 putLamp
|
||||
, windowLine (0,h-20) (40,h-20)
|
||||
, PS (-50,h-85) 0 putLamp
|
||||
, sPS (-50,h-85) 0 putLamp
|
||||
, windowLine (-40,h-60) (-40,h-100)
|
||||
, PS ( 20,h-40) 0 $ PutID 0
|
||||
, PS (-20,h-80) 0 $ PutID 2
|
||||
, sPS ( 20,h-40) 0 $ PutID 0
|
||||
, sPS (-20,h-80) 0 $ PutID 2
|
||||
]
|
||||
, _rmBound = [poly]
|
||||
}
|
||||
@@ -59,9 +59,9 @@ longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
||||
longBlockedCorridor = do
|
||||
r <- state $ randomR (0,pi)
|
||||
n <- state $ randomR (0,3)
|
||||
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
|
||||
let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
|
||||
$ reverse $ rectNSWE 10 (-10) (-10) 10
|
||||
,PS (20,15) 0 putLamp
|
||||
,sPS (20,15) 0 putLamp
|
||||
]
|
||||
sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor)
|
||||
$ return $ Right $ set rmPS plmnts corridor
|
||||
@@ -70,8 +70,8 @@ longBlockedCorridor = do
|
||||
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
||||
blockedCorridor = do
|
||||
r <- state $ randomR (0,pi)
|
||||
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
|
||||
let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
|
||||
$ reverse $ rectNSWE 10 (-10) (-10) 10
|
||||
,PS (20,15) 0 putLamp
|
||||
,sPS (20,15) 0 putLamp
|
||||
]
|
||||
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
|
||||
|
||||
@@ -28,8 +28,8 @@ telRoomLev i = do
|
||||
w <- state $ randomR (200,300)
|
||||
h <- state $ randomR (200,300)
|
||||
return $ roomRectAutoLinks w h & rmPS .~
|
||||
[ PS (w/2,h/2) 0 $ PutPressPlate telPP
|
||||
, PS (w/2,h/2+ 30) 0 putLamp
|
||||
[ sPS (w/2,h/2) 0 $ PutPressPlate telPP
|
||||
, sPS (w/2,h/2+ 30) 0 putLamp
|
||||
]
|
||||
where
|
||||
telPP = PressPlate
|
||||
|
||||
+13
-18
@@ -1,4 +1,4 @@
|
||||
{-
|
||||
{- |
|
||||
Rooms that contain valuable items, typically protected in some manner.
|
||||
Typically dead ends.
|
||||
-}
|
||||
@@ -13,13 +13,10 @@ import Dodge.LevelGen.Data
|
||||
import Data.List
|
||||
import Control.Monad.State
|
||||
import Control.Lens
|
||||
import System.Random
|
||||
|
||||
{-
|
||||
A triangular room with loot at the top (with 'PutID' 2),
|
||||
import System.Random
|
||||
{- | A triangular room with loot at the top (with 'PutID' 2),
|
||||
creatures in the bottom two corners (with 'PutID' 0),
|
||||
and (single) entrance bottom middle.
|
||||
-}
|
||||
and (single) entrance bottom middle. -}
|
||||
triLootRoom
|
||||
:: Float -- Width
|
||||
-> Float -- Height
|
||||
@@ -31,13 +28,13 @@ triLootRoom w h = pure $ Room
|
||||
, _rmLinks = [((0,-80),pi)]
|
||||
, _rmPath = doublePair ((0,-80),(0,h/2))
|
||||
, _rmPS =
|
||||
[PS (15-w,15) 0 $ PutID 0
|
||||
,PS (w-15,15) pi $ PutID 0
|
||||
,PS (0,h-35) 0 $ PutID 2
|
||||
,PS (-5,h-10) 0 putLamp
|
||||
,PS (5,h-10) 0 putLamp
|
||||
,PS (0,h-15) 0 putLamp
|
||||
,PS (0,-60) 0 putLamp
|
||||
[sPS (15-w, 15) 0 $ PutID 0
|
||||
,sPS (w-15, 15) pi $ PutID 0
|
||||
,sPS ( 0,h-35) 0 $ PutID 2
|
||||
,sPS ( -5,h-10) 0 putLamp
|
||||
,sPS ( 5,h-10) 0 putLamp
|
||||
,sPS ( 0,h-15) 0 putLamp
|
||||
,sPS ( 0, -60) 0 putLamp
|
||||
]
|
||||
, _rmBound = [tri , base]
|
||||
}
|
||||
@@ -50,10 +47,8 @@ triLootRoom w h = pure $ Room
|
||||
, ( 20, h)
|
||||
, (-20, h)
|
||||
]
|
||||
base = rectNSWE 20 (-80) (-20) 20
|
||||
|
||||
{- Create a random room with one entrance containing given creatures and items.
|
||||
-}
|
||||
base = rectNSWE 20 (-80) (-20) 20
|
||||
{- | Create a random room with one entrance containing given creatures and items. -}
|
||||
lootRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
|
||||
lootRoom crs itms = do
|
||||
let w = 300
|
||||
|
||||
Reference in New Issue
Block a user