Refactoring
This commit is contained in:
@@ -23,7 +23,7 @@ airlockOneWay n = Room
|
||||
, _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 (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40)
|
||||
,PS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState
|
||||
(M.insert (DoorNumOpen n) True))
|
||||
]
|
||||
@@ -60,7 +60,7 @@ airlock0 n = Room
|
||||
]
|
||||
, _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 (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0)
|
||||
,PS (35,50) (pi/2) $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen n) True))
|
||||
(over worldState (M.insert (DoorNumOpen n) False))
|
||||
|
||||
@@ -66,7 +66,7 @@ randomMediumRoom = takeOne
|
||||
[ roomOctogon 300
|
||||
, roomCross 180 300
|
||||
, roomShuriken 200 300
|
||||
, roomTwistCross 230 300 (0)
|
||||
, roomTwistCross 230 300 0
|
||||
]
|
||||
|
||||
roomCross
|
||||
|
||||
@@ -21,7 +21,7 @@ corridor = Room
|
||||
lnks =
|
||||
[((20,70) ,0)
|
||||
,((20,70), pi/6)
|
||||
,((20,70), 0-pi/6)
|
||||
,((20,70), negate $ pi/6)
|
||||
,((20,10) ,pi)
|
||||
]
|
||||
corridorN :: Room
|
||||
|
||||
+24
-21
@@ -40,7 +40,7 @@ twinSlowDoorRoom drID w h x = Room
|
||||
, _rmPS =
|
||||
[ PS (0,h/2) 0 putLamp
|
||||
, PS (25,5) 0 putLamp
|
||||
, PS (negate $ 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
|
||||
@@ -57,7 +57,7 @@ twinSlowDoorRoom drID w h x = Room
|
||||
[0..nDrp]
|
||||
drR = fmap ((\h' -> ((-x,-h'),(-x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
|
||||
[0..nDrp]
|
||||
nDrp = ceiling $ h
|
||||
nDrp = ceiling h
|
||||
cond w = or $ M.lookup (DoorNumOpen drID) (_worldState w)
|
||||
col = dim $ dim $ bright red
|
||||
|
||||
@@ -82,31 +82,34 @@ slowDoorRoom = do
|
||||
,( (x/2+50,5),0)
|
||||
]
|
||||
let n = 25
|
||||
xs <- sequence $ replicate n $ state $ randomR (10,x-10)
|
||||
ys <- sequence $ replicate n $ state $ randomR (h+20,y)
|
||||
rs <- sequence $ replicate n $ state $ randomR (0,2*pi)
|
||||
xs <- replicateM n $ state $ randomR (10,x-10)
|
||||
ys <- replicateM n $ state $ randomR (h+20,y)
|
||||
rs <- replicateM n $ state $ randomR (0,2*pi)
|
||||
let ps = zip xs ys
|
||||
xs' <- sequence $ replicate 5 $ state $ randomR (10,x-10)
|
||||
ys' <- sequence $ replicate 5 $ state $ randomR (h+20,y)
|
||||
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]
|
||||
let barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
|
||||
let pillarsa = []
|
||||
let 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)
|
||||
++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
|
||||
let pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
|
||||
barrels = zipWith (\x y -> PS (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)
|
||||
++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
|
||||
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
|
||||
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
|
||||
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
|
||||
let cond x = (snd . fst) x > h + 40
|
||||
let cond2 x = (snd . fst) x < h - 40
|
||||
cond2 x = (snd . fst) x < h - 40
|
||||
but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (0,h) (x,h)
|
||||
-- ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h)
|
||||
]
|
||||
fmap connectRoom (filterLinks cond =<< (changeLinkTo cond2
|
||||
$ set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
|
||||
$ roomRectAutoLinks x y
|
||||
))
|
||||
fmap connectRoom
|
||||
(filterLinks cond =<<
|
||||
changeLinkTo cond2
|
||||
(set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
|
||||
$ roomRectAutoLinks x y
|
||||
)
|
||||
)
|
||||
|
||||
randC1 = RandPS $ takeOne $ map PutCrit $ (armourChaseCrit : replicate 50 chaseCrit)
|
||||
randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit
|
||||
|
||||
@@ -62,9 +62,11 @@ roomRectAutoLinks :: Float -> Float -> Room
|
||||
roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
|
||||
|
||||
makeGrid :: Float -> Int -> Float -> Int -> [(Point2,Point2)]
|
||||
makeGrid x nx y ny = nub $ concatMap doublePair
|
||||
$ concatMap (\p -> map (\(a,b) -> (p +.+ a,p +.+ b)) $ makeRect x y)
|
||||
$ gridPoints x nx y ny
|
||||
makeGrid x nx y ny
|
||||
= nub
|
||||
. concatMap doublePair
|
||||
. concatMap (\p -> map (\(a,b) -> (p +.+ a,p +.+ b)) $ makeRect x y)
|
||||
$ gridPoints x nx y ny
|
||||
|
||||
gridPoints :: Float -> Int -> Float -> Int -> [Point2]
|
||||
gridPoints x nx y ny = [(a,b) | a <- take nx $ scanl (+) 0 $ repeat x
|
||||
@@ -230,7 +232,7 @@ centerVaultRoom n w h d = do
|
||||
nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
|
||||
weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20))
|
||||
centerPoly = rectWdthHght (d - 20) (d - 20)
|
||||
polys = centerPoly : nsDoors : weDoors : (take 4 $ iterate (map vNormal) northPoly)
|
||||
polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
|
||||
return $ Room
|
||||
{ _rmPolys = polys
|
||||
, _rmLinks =
|
||||
|
||||
Reference in New Issue
Block a user