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/RoadBlock.hs
+15 -15
View File
@@ -32,21 +32,21 @@ litCorridor90 = do
poly2 = rectNSWE (h-60) (h-100) (-60) 5
pure $ defaultRoom
{ _rmPolys = [poly,poly2]
, _rmLinks = [ ((40,h - 80), -pi/2)
, ((20, 0), pi)
, _rmLinks = [ ((V2 (40) (h - 80)), -pi/2)
, ((V2 (20) ( 0)), pi)
]
, _rmPath = concatMap doublePair
[((20,0),(20,h-40))
,(( 0,h-40),(20,h-40))
,((40,h-40),(20,h-40))
[((V2 20 0),(V2 (20) (h-40)))
,((V2 ( 0) (h-40)),(V2 (20) (h-40)))
,((V2 (40) (h-40)),(V2 (20) (h-40)))
]
, _rmPS =
[ sPS (20,h-5) 0 putLamp
, windowLine (0,h-20) (40,h-20)
, sPS (-50,h-85) 0 putLamp
, windowLine (-40,h-60) (-40,h-100)
, sPS ( 20,h-40) 0 $ PutID 0
, sPS (-20,h-80) 0 $ PutID 2
[ sPS (V2 (20) (h-5)) 0 putLamp
, windowLine (V2 (0) (h-20)) (V2 (40) (h-20))
, sPS (V2 (-50) (h-85)) 0 putLamp
, windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100))
, sPS (V2 ( 20) (h-40)) 0 $ PutID 0
, sPS (V2 (-20) (h-80)) 0 $ PutID 2
]
, _rmBound = [poly]
}
@@ -60,9 +60,9 @@ longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
longBlockedCorridor = do
r <- state $ randomR (0,pi)
n <- state $ randomR (0,3)
let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
let plmnts = [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) (75/256) (0) (250/256))
$ reverse $ rectNSWE 10 (-10) (-10) 10
,sPS (20,15) 0 putLamp
,sPS (V2 20 15) 0 putLamp
]
sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor)
$ return $ Right $ set rmPS plmnts corridor
@@ -71,8 +71,8 @@ longBlockedCorridor = do
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
blockedCorridor = do
r <- state $ randomR (0,pi)
let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
let plmnts = [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) ( 0) ( 250/256))
$ reverse $ rectNSWE 10 (-10) (-10) 10
,sPS (20,15) 0 putLamp
,sPS (V2 20 15) 0 putLamp
]
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor