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

More strictifiiiying

Browse Source
This commit is contained in:
justin
2021-07-30 01:25:11 +02:00
parent 2d8b27746c
commit 7b7fd302d8
37 changed files with 459 additions and 448 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/LongDoor.hs
+22 -22
View File
@@ -33,18 +33,18 @@ twinSlowDoorRoom
twinSlowDoorRoom drID w h x = defaultRoom
{ _rmPolys = ps
, _rmLinks =
[ ((w,h/2) , negate $ pi/2)
, ((-w,h/2) , pi/2)
, ((0,-h), pi)
[ ((V2 (w) (h/2)) , negate $ pi/2)
, ((V2 (-w) (h/2)) , pi/2)
, ((V2 (0) (-h)), pi)
]
, _rmPath = []
, _rmPS =
[ 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
[ sPS (V2 (0) (h/2)) 0 putLamp
, sPS (V2 (25) (5)) 0 putLamp
, sPS (V2 (negate 25) (5)) 0 putLamp
, sPS (V2 0 0) 0 $ PutDoor col (not . cond) drL
, sPS (V2 0 0) 0 $ PutDoor col (not . cond) drR
, sPS (V2 (0) (h-5)) pi $ PutButton $ makeButton col
(over worldState (M.insert (DoorNumOpen drID) True))
]
, _rmBound = ps
@@ -54,9 +54,9 @@ twinSlowDoorRoom drID w h x = defaultRoom
[rectNSWE h (-2) (-w) w
,rectNSWE 20 (-h) (negate x) x
]
drL = fmap ((\h' -> ((x,-h'),(x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
drL = fmap ((\h' -> ((V2 (x) (-h')),(V2 (x) (h-h')))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
[0..nDrp]
drR = fmap ((\h' -> ((-x,-h'),(-x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
drR = fmap ((\h' -> ((V2 (-x) (-h')),(V2 (-x) (h-h')))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
[0..nDrp]
nDrp = ceiling h :: Int
cond w' = or $ M.lookup (DoorNumOpen drID) (_worldState w')
@@ -67,8 +67,8 @@ twinSlowDoorChasers
=> Int -- ^ Door id
-> State g Room
twinSlowDoorChasers drid = do
let lps = (-65 ,) <$> [20,40 .. 180]
rps = (65 ,) <$> [20,40 .. 180]
let lps = (V2 (-65)) <$> [20,40 .. 180]
rps = (V2 65) <$> [20,40 .. 180]
ps <- takeN 4 $ lps ++ rps
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
@@ -79,19 +79,19 @@ slowDoorRoom = do
y <- state $ randomR (400,800)
h <- state $ randomR (200,min (y-100) 500)
(butPos,butRot) <- takeOne
[( (x/2-50,5),0)
,( (x/2+50,5),0)
[( (V2 (x/2-50) (5)),0)
,( (V2 (x/2+50) (5)),0)
]
let n = 25
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
let ps = zipWith V2 xs ys
xs' <- replicateM 5 $ state $ randomR (10,x-10)
ys' <- replicateM 5 $ state $ randomR (h+20,y)
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'
lsources = [sPS (V2 (x/2) (30)) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
barrels = zipWith (\x' y' -> sPS (V2 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)
@@ -100,15 +100,15 @@ slowDoorRoom = do
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
cond2 x' = (snd . fst) x' < h - 40
but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (0,h) (x,h)
let cond x' = (sndV2 . fst) x' > h + 40
cond2 x' = (sndV2 . fst) x' < h - 40
but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h)
-- ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h)
]
fmap connectRoom
(filterLinks cond =<<
changeLinkTo cond2
(set rmPS ([sPS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
(set rmPS ([sPS (V2 0 0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
$ roomRectAutoLinks x y
)
)