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

Add to procedural room

Browse Source
This commit is contained in:
jgk
2021-04-24 16:31:48 +02:00
parent aa08d66026
commit a409ddc8a7
1 changed files with 20 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Procedural.hs
+20 -15
View File
@@ -156,23 +156,28 @@ fourthCorner w = Room
fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do
let l = w/2 - 30
b <- takeOne
[ [blockLine (5,5) (w-50,w-50)
,PS (0,w) 0 putLamp
,PS (0,w-30) 0 PutNothing
[ [ PS (10-w,w) 0 putLamp
, PS (w-10,w) 0 putLamp
, PS (0,10) 0 putLamp
, PS (0,2*w-20) pi PutNothing
, blockLine (w/2,w/2) (0,w)
, blockLine (negate $ w/2,w/2) (0,w)
]
, [blockLine (0,5) (0,2*w-60)
,PS (-50,w) 0 putLamp
,PS (50,w) 0 PutNothing
, [ PS (0,3*w/2) 0 putLamp
, PS (w-10,w) 0 putLamp
, PS (10-w,w-20) 0 putLamp
, PS (0,10) 0 putLamp
, PS (0,2*w-20) pi PutNothing
, blockLine (w/2,w/2) (0,w)
, blockLine (negate $ w,w) (0,w)
]
, [blockLine (50,50) (w,w)
,PS (0,w) 0 putLamp
,PS (w-40,w) (pi/4) PutNothing
]
, [blockLine (40-l,l+40) (w-l,l+w)
,PS (0,w) 0 putLamp
,PS (w-40,0) (pi/8) PutNothing
, [ PS (10-w,w) 0 putLamp
, PS (w-10,w) 0 putLamp
, PS (0,10) 0 putLamp
, PS (20,2*w-40) pi PutNothing
, blockLine (w/2,w/2) (0,w)
, blockLine (0,w) (0,w*2)
]
]
pure $ Room
@@ -196,7 +201,7 @@ fillNothingPlacement pst r =
testRoom :: RandomGen g => State g Room
testRoom = do
corners <- replicateM 4 . join $ takeOne [fourthWall 100] --, fourthCornerWall 100]
corners <- replicateM 4 . join $ takeOne [fourthWall 100, fourthCornerWall 100]
-- corners <- replicateM 4 (fourthCornerWall 100)
randomiseAllLinks
. fillNothingPlacement (PutCrit chaseCrit)