justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactoring

Browse Source
This commit is contained in:
justin
2021-05-03 23:59:20 +02:00
parent b826299cbd
commit e21178b688
20 changed files with 830 additions and 731 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/LongDoor.hs
+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