Add to procedural room

src/Dodge/Room/Procedural.hs

@@ -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 (10-w,w)  0 putLamp
-            ,PS (0,w) 0 putLamp
+            , PS (w-10,w) 0 putLamp
-            ,PS (0,w-30) 0 PutNothing
+            , 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 (0,3*w/2)  0 putLamp
-            ,PS (-50,w) 0 putLamp
+            , PS (w-10,w) 0 putLamp
-            ,PS (50,w) 0 PutNothing
+            , 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 (10-w,w) 0 putLamp
-            ,PS (0,w) 0 putLamp
+            , PS (w-10,w) 0 putLamp
-            ,PS (w-40,w) (pi/4) PutNothing
+            , PS (0,10)   0 putLamp
-            ]
+            , PS (20,2*w-40) pi PutNothing
-        ,   [blockLine (40-l,l+40) (w-l,l+w)
+            , blockLine (w/2,w/2) (0,w)
-            ,PS (0,w) 0 putLamp
+            , blockLine (0,w) (0,w*2)
-            ,PS (w-40,0) (pi/8) PutNothing
             ]
         ]
     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)