Move toward better info display during level generation
This commit is contained in:
+44
-57
@@ -34,26 +34,22 @@ import System.Random
|
||||
import Data.Tree
|
||||
import Data.Bifunctor
|
||||
|
||||
roomC :: Float -> Float -> Room
|
||||
roomC x y = defaultRoom
|
||||
{ _rmPolys = [rectNSWE y 0 0 x]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = pth
|
||||
, _rmPS = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
|
||||
]
|
||||
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
|
||||
}
|
||||
where
|
||||
lnks = map (first toV2)
|
||||
[( (x-20, 0),pi)
|
||||
,( ( 20, 0),pi)
|
||||
,( ( 0, 20),pi/2)
|
||||
]
|
||||
xn = 4
|
||||
yn = 4
|
||||
yd = (y - 40) / fromIntegral yn
|
||||
xd = (x - 40) / fromIntegral xn
|
||||
pth = linksAndPath lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
|
||||
roomC :: RandomGen g => Float -> Float -> State g Room
|
||||
roomC w h = do
|
||||
wl <- takeOne
|
||||
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
|
||||
, windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
|
||||
]
|
||||
changeLinkFrom fromCond $ roomRectAutoLinks w h
|
||||
& rmPS %~ (wl : )
|
||||
& rmRandPSs .~ [farside]
|
||||
where
|
||||
fromCond (V2 x _,_) = x < w / 2 - 10
|
||||
farside = do
|
||||
x <- state $ randomR (5, w/2 - 20)
|
||||
y <- state $ randomR (5, h - 70)
|
||||
a <- state $ randomR (0, 2*pi)
|
||||
return (V2 x y,a)
|
||||
|
||||
roomPadCut :: [Point2] -> Point2 -> Room
|
||||
roomPadCut ps p = defaultRoom
|
||||
@@ -355,14 +351,9 @@ weaponRoom = join $ takeOne
|
||||
, weaponLongCorridor
|
||||
]
|
||||
|
||||
roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
|
||||
roomCCrits = do
|
||||
ps <- replicateM 20 $ randInCirc 9
|
||||
let plmnts = map (\p -> sPS p 0 randC1)
|
||||
$ zipWith (+.+) [V2 x y | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
|
||||
lamps = [sPS (V2 50 100) 0 putLamp , sPS (V2 175 100) 0 putLamp]
|
||||
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
|
||||
|
||||
roomCCrits :: RandomGen g => State g Room
|
||||
roomCCrits = roomC 200 200
|
||||
<&> rmPS %~ (replicate 20 (Placement (PSRoomRand 0) randC1 (const Nothing)) ++ )
|
||||
|
||||
longRoom :: RandomGen g => State g Room
|
||||
longRoom = do
|
||||
@@ -410,18 +401,16 @@ shootersRoom' = do
|
||||
x1 <- state $ randomR (20,w/3-20)
|
||||
x2 <- state $ randomR (w/3+20,2*w/3-20)
|
||||
x3 <- state $ randomR (2*w/3+20,w-20)
|
||||
y1 <- state $ randomR (250,550)
|
||||
y2 <- state $ randomR (250,550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
|
||||
y1 <- state $ randomR (280,550)
|
||||
y2 <- state $ randomR (280,550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280,560)
|
||||
x4 <- state $ randomR (60,w-60)
|
||||
y4 <- state $ randomR (40,180)
|
||||
--p <- takeOne [V2 x1 y1,V2 x2 y2,V2 x3 y3]
|
||||
y4 <- state $ randomR (40,150)
|
||||
let bln x y = putBlockN (x+25) (x-25) (y+20) (y+10)
|
||||
blv x y = putBlockV (x+25) (x-25) (y+20) (y+10)
|
||||
plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
||||
++ [spanLightI (V2 0 200) (V2 w 200)
|
||||
, mntLightLnkCond (\(V2 _ y,_) -> y < 50)
|
||||
, mntLightLnkCond (\(V2 _ y,_) -> y > 550)
|
||||
++ [spanLightI (V2 (-10) 200) (V2 (w/2) 200)
|
||||
,spanLightI (V2 (w/2) 200) (V2 (w+10) 200)
|
||||
]
|
||||
toPS x y = return (V2 x y,-0.5*pi)
|
||||
return $ set rmPS plmnts $ roomRectAutoLinks w 600
|
||||
@@ -460,7 +449,10 @@ pillarGrid = do
|
||||
y <- takeOne ys
|
||||
a <- state $ randomR (0,2*pi)
|
||||
return (V2 (x+gap) y,a)
|
||||
let plmnts = replicate 30 (mntLightLnkCond (const True))
|
||||
cornerRestrict (V2 x y,_)
|
||||
= (x > 40 && x < h - 40)
|
||||
|| (y > 40 && y < h - 40)
|
||||
let plmnts = replicate 8 (mntLightLnkCond cornerRestrict)
|
||||
++
|
||||
concat [f x y | x<-xs,y<-ys]
|
||||
return $ roomRect w h (max i 2) (max i 2)
|
||||
@@ -480,31 +472,26 @@ pistolerRoom = pillarGrid
|
||||
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
|
||||
shootingRange = do
|
||||
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
|
||||
>>= filterLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
>>= filterLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
>>= filterLinks (\(_,r) -> r == 0)
|
||||
return $ treeFromPost [Left rm1
|
||||
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
|
||||
,Left rm2
|
||||
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
|
||||
]
|
||||
(Right rm3)
|
||||
>>= changeLinkFrom (\(_,r) -> r == 0)
|
||||
return $ treeFromPost
|
||||
[Left rm1
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
,Left rm2
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
]
|
||||
(Right rm3)
|
||||
|
||||
spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
spawnerRoom = do
|
||||
x <- state $ randomR (250,300)
|
||||
y <- state $ randomR (300,400)
|
||||
wl <- takeOne [sPS (V2 0 0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
|
||||
defaultCrystalWall
|
||||
,windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
|
||||
]
|
||||
let plmnts = [sPS (V2 (x/4) ( y/4)) (pi/2) $ PutCrit spawnerCrit
|
||||
,wl
|
||||
,sPS (V2 (x/2) ( y-10)) 0 putLamp
|
||||
]
|
||||
let f (V2 lx _,_) = lx < x/2-5
|
||||
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)
|
||||
roomWithSpawner <- roomC x y <&>
|
||||
rmPS %~ (Placement (PSRoomRand 0) (PutCrit spawnerCrit) (const Nothing) :)
|
||||
aRoom <- airlock
|
||||
return $ treeFromTrunk [Left aRoom] roomWithSpawner
|
||||
return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner
|
||||
|
||||
Reference in New Issue
Block a user