Refactoring

This commit is contained in:
2021-05-03 23:59:20 +02:00
parent b826299cbd
commit e21178b688
20 changed files with 830 additions and 731 deletions
+2 -2
View File
@@ -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))
+1 -1
View File
@@ -66,7 +66,7 @@ randomMediumRoom = takeOne
[ roomOctogon 300
, roomCross 180 300
, roomShuriken 200 300
, roomTwistCross 230 300 (0)
, roomTwistCross 230 300 0
]
roomCross
+1 -1
View File
@@ -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
View File
@@ -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
+6 -4
View File
@@ -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 =